home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 37 / IOPROG_37.ISO / SOFT / Multilizer.exe / disk1 / data1.cab / data1 / [Group9]VCL Source Standard / ivgrids.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-12  |  135.1 KB  |  4,923 lines
  1. unit IvGrids;
  2.  
  3. {$I IVMULTI.INC}
  4.  
  5. interface
  6.  
  7. {$IFDEF IVBIDI}
  8. uses
  9.   Grids;
  10.  
  11. type
  12.   TIvDrawGrid = class(TDrawGrid)
  13.   end;
  14.  
  15.   TIvStringGrid = class(TStringGrid)
  16.   end;
  17. {$ELSE}
  18.  
  19. {$R-}
  20.  
  21. uses
  22.   Windows, SysUtils, Messages, Classes, Graphics, Menus, Controls, Forms,
  23.   StdCtrls, Mask;
  24.  
  25. const
  26.   IvMaxCustomExtents = MaxListSize;
  27.   IvMaxShortInt = High(ShortInt);
  28.  
  29. type
  30.   EIvInvalidGridOperation = class(Exception);
  31.  
  32.   TIvGetExtentsFunc = function(Index: Longint): Integer of object;
  33.  
  34.   TIvGridAxisType = (gaHorizontal, gaVertical);
  35.  
  36.   TIvGridAxisDrawInfo = record
  37.     AxisType: TIvGridAxisType;
  38.     EffectiveLineWidth: Integer;
  39.     FixedBoundary: Integer;
  40.     GridBoundary: Integer;
  41.     GridExtent: Integer;
  42.     LastFullVisibleCell: Longint;
  43.     FullVisBoundary: Integer;
  44.     FixedCellCount: Integer;
  45.     FirstGridCell: Integer;
  46.     GridCellCount: Integer;
  47.     GetExtent: TIvGetExtentsFunc;
  48.   end;
  49.  
  50.   TIvGridDrawInfo = record
  51.     Horz, Vert: TIvGridAxisDrawInfo;
  52.   end;
  53.  
  54.   TIvGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing, gsRowMoving,
  55.     gsColMoving);
  56.  
  57.   { TIvInplaceEdit }
  58.  
  59.   TIvCustomGrid = class;
  60.  
  61.   TIvInplaceEdit = class(TCustomMaskEdit)
  62.   private
  63.     FGrid: TIvCustomGrid;
  64.     FClickTime: Longint;
  65.  
  66.     procedure SetGrid(value: TIvCustomGrid);
  67.  
  68.     procedure InternalMove(const Loc: TRect; Redraw: Boolean);
  69.  
  70.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  71.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  72.     procedure WMPaste(var Message); message WM_PASTE;
  73.     procedure WMCut(var Message); message WM_CUT;
  74.     procedure WMClear(var Message); message WM_CLEAR;
  75.  
  76.   protected
  77.     procedure CreateParams(var Params: TCreateParams); override;
  78.     procedure DblClick; override;
  79.     function EditCanModify: Boolean; override;
  80.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  81.     procedure KeyPress(var Key: Char); override;
  82.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  83.     procedure BoundsChanged; virtual;
  84.     procedure UpdateContents; virtual;
  85.     procedure WndProc(var Message: TMessage); override;
  86.  
  87.     property Grid: TIvCustomGrid read FGrid;
  88.  
  89.   public
  90.     constructor Create(AOwner: TComponent); override;
  91.  
  92.     procedure Deselect;
  93.     procedure Hide;
  94.     procedure Invalidate; override;
  95.     procedure Move(const Loc: TRect);
  96.     function PosEqual(const Rect: TRect): Boolean;
  97.     procedure SetFocus; override;
  98.     procedure UpdateLoc(const Loc: TRect);
  99.     procedure UpdateBidi(value: Boolean);
  100.     function Visible: Boolean;
  101.   end;
  102.  
  103.   { TIvCustomGrid }
  104.  
  105.   TIvGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  106.     goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
  107.     goColMoving, goEditing, goTabs, goRowSelect,
  108.     goAlwaysShowEditor, goThumbTracking);
  109.   TIvGridOptions = set of TIvGridOption;
  110.   TIvGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  111.   TIvGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
  112.  
  113.   TIvGridCoord = record
  114.     X: Longint;
  115.     Y: Longint;
  116.   end;
  117.  
  118.   TIvGridRect = record
  119.     case Integer of
  120.       0: (Left, Top, Right, Bottom: Longint);
  121.       1: (TopLeft, BottomRight: TIvGridCoord);
  122.   end;
  123.  
  124.   TIvSelectCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  125.     var CanSelect: Boolean) of object;
  126.   TIvDrawCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  127.     Rect: TRect; State: TIvGridDrawState) of object;
  128.  
  129.   TIvCustomGrid = class(TCustomControl)
  130.   private
  131.     FAnchor: TIvGridCoord;
  132.     FBorderStyle: TBorderStyle;
  133.     FCanEditModify: Boolean;
  134.     FColCount: Longint;
  135.     FColWidths: Pointer;
  136.     FTabStops: Pointer;
  137.     FCurrent: TIvGridCoord;
  138.     FDefaultColWidth: Integer;
  139.     FDefaultRowHeight: Integer;
  140.     FFixedCols: Integer;
  141.     FFixedRows: Integer;
  142.     FFixedColor: TColor;
  143.     FGridLineWidth: Integer;
  144.     FOptions: TIvGridOptions;
  145.     FRowCount: Longint;
  146.     FRowHeights: Pointer;
  147.     FScrollBars: TScrollStyle;
  148.     FTopLeft: TIvGridCoord;
  149.     FSizingIndex: Longint;
  150.     FSizingPos, FSizingOfs: Integer;
  151.     FMoveIndex, FMovePos: Longint;
  152.     FHitTest: TPoint;
  153.     FInplaceEdit: TIvInplaceEdit;
  154.     FInplaceCol, FInplaceRow: Longint;
  155.     FColOffset: Integer;
  156.     FDefaultDrawing: Boolean;
  157.     FEditorMode: Boolean;
  158.     FLocale: Integer;
  159.     FColLocale: TList;
  160.  
  161.     procedure SetLocale(value: Integer);
  162.  
  163.     function GetColLocale(index: Integer): Integer;
  164.     procedure SetColLocale(index: Integer; value: Integer);
  165.  
  166.     function CalcCoordFromPoint(X, Y: Integer;
  167.       const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  168.     procedure CalcDrawInfo(var DrawInfo: TIvGridDrawInfo);
  169.     procedure CalcDrawInfoXY(var DrawInfo: TIvGridDrawInfo;
  170.       UseWidth, UseHeight: Integer);
  171.     procedure CalcFixedInfo(var DrawInfo: TIvGridDrawInfo);
  172.     function CalcMaxTopLeft(const Coord: TIvGridCoord;
  173.       const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  174.     procedure CalcSizingState(X, Y: Integer; var State: TIvGridState;
  175.       var Index: Longint; var SizingPos, SizingOfs: Integer;
  176.       var FixedInfo: TIvGridDrawInfo);
  177.     procedure ChangeSize(NewColCount, NewRowCount: Longint);
  178.     procedure ClampInView(const Coord: TIvGridCoord);
  179.     procedure DrawSizingLine(const DrawInfo: TIvGridDrawInfo);
  180.     procedure DrawMove;
  181.     procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  182.     procedure GridRectToScreenRect(
  183.       GridRect: TIvGridRect;
  184.       var ScreenRect: TRect;
  185.       IncludeLine: Boolean);
  186.     procedure HideEdit;
  187.     procedure Initialize;
  188.     procedure InvalidateGrid;
  189.     procedure InvalidateRect(ARect: TIvGridRect);
  190.     procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  191.     procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  192.     procedure MoveAnchor(const NewAnchor: TIvGridCoord);
  193.     procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TIvGridDrawInfo;
  194.       var Axis: TIvGridAxisDrawInfo; Scrollbar: Integer);
  195.     procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  196.     procedure MoveTopLeft(ALeft, ATop: Longint);
  197.     procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  198.     procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  199.     procedure SelectionMoved(const OldSel: TIvGridRect);
  200.     procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TIvGridDrawInfo);
  201.     procedure TopLeftMoved(const OldTopLeft: TIvGridCoord);
  202.     procedure UpdateScrollPos;
  203.     procedure UpdateScrollRange;
  204.     function GetColWidths(Index: Longint): Integer;
  205.     function GetRowHeights(Index: Longint): Integer;
  206.     function GetSelection: TIvGridRect;
  207.     function GetTabStops(Index: Longint): Boolean;
  208.     function GetVisibleColCount: Integer;
  209.     function GetVisibleRowCount: Integer;
  210.     function IsActiveControl: Boolean;
  211.     procedure ReadColWidths(Reader: TReader);
  212.     procedure ReadRowHeights(Reader: TReader);
  213.     procedure SetBorderStyle(Value: TBorderStyle);
  214.     procedure SetCol(Value: Longint);
  215.     procedure SetColCount(Value: Longint);
  216.     procedure SetColWidths(Index: Longint; Value: Integer);
  217.     procedure SetDefaultColWidth(Value: Integer);
  218.     procedure SetDefaultRowHeight(Value: Integer);
  219.     procedure SetEditorMode(Value: Boolean);
  220.     procedure SetFixedColor(Value: TColor);
  221.     procedure SetFixedCols(Value: Integer);
  222.     procedure SetFixedRows(Value: Integer);
  223.     procedure SetGridLineWidth(Value: Integer);
  224.     procedure SetLeftCol(Value: Longint);
  225.     procedure SetOptions(Value: TIvGridOptions);
  226.     procedure SetRow(Value: Longint);
  227.     procedure SetRowCount(Value: Longint);
  228.     procedure SetRowHeights(Index: Longint; Value: Integer);
  229.     procedure SetScrollBars(Value: TScrollStyle);
  230.     procedure SetSelection(Value: TIvGridRect);
  231.     procedure SetTabStops(Index: Longint; Value: Boolean);
  232.     procedure SetTopRow(Value: Longint);
  233.     procedure UpdateEdit;
  234.     procedure UpdateText;
  235.     procedure WriteColWidths(Writer: TWriter);
  236.     procedure WriteRowHeights(Writer: TWriter);
  237.     procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
  238.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  239.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  240.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  241.     procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  242.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  243.     procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  244.     procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  245.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  246.     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  247.     procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
  248.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  249.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  250.     procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  251.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  252.     procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
  253.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  254.  
  255.   protected
  256.     FGridState: TIvGridState;
  257.     FSaveCellExtents: Boolean;
  258.     DesignOptionsBoost: TIvGridOptions;
  259.     VirtualView: Boolean;
  260.  
  261.     function CreateEditor: TIvInplaceEdit; virtual;
  262.     procedure CreateParams(var Params: TCreateParams); override;
  263.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  264.     procedure KeyPress(var Key: Char); override;
  265.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  266.       X, Y: Integer); override;
  267.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  268.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  269.       X, Y: Integer); override;
  270.     procedure AdjustSize(Index, Amount: Longint; Rows: Boolean);dynamic;
  271.     function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  272.     procedure DoExit; override;
  273.     function CellRect(ACol, ARow: Longint): TRect;
  274.     function CanEditAcceptKey(Key: Char): Boolean; dynamic;
  275.     function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
  276.     function CanEditModify: Boolean; dynamic;
  277.     function CanEditShow: Boolean; virtual;
  278.     function GetEditText(ACol, ARow: Longint): string; dynamic;
  279.     procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
  280.     function GetEditMask(ACol, ARow: Longint): string; dynamic;
  281.     function GetEditLimit: Integer; dynamic;
  282.     function GetGridWidth: Integer;
  283.     function GetGridHeight: Integer;
  284.     procedure HideEditor;
  285.     procedure ShowEditor;
  286.     procedure ShowEditorChar(Ch: Char);
  287.     procedure InvalidateEditor;
  288.     procedure MoveColumn(FromIndex, ToIndex: Longint);
  289.     procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
  290.     procedure MoveRow(FromIndex, ToIndex: Longint);
  291.     procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
  292.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  293.       AState: TIvGridDrawState); virtual; abstract;
  294.     procedure DefineProperties(Filer: TFiler); override;
  295.     procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  296.     function SelectCell(ACol, ARow: Longint): Boolean; virtual;
  297.     procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
  298.     function Sizing(X, Y: Integer): Boolean;
  299.     procedure ScrollData(DX, DY: Integer);
  300.     procedure InvalidateCell(ACol, ARow: Longint);
  301.     procedure InvalidateCol(ACol: Longint);
  302.     procedure InvalidateRow(ARow: Longint);
  303.     procedure TopLeftChanged; dynamic;
  304.     procedure TimedScroll(Direction: TIvGridScrollDirection); dynamic;
  305.     procedure Paint; override;
  306.     procedure ColWidthsChanged; dynamic;
  307.     procedure RowHeightsChanged; dynamic;
  308.     procedure DeleteColumn(ACol: Longint);
  309.     procedure DeleteRow(ARow: Longint);
  310.     procedure UpdateDesigner;
  311.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  312.     property Col: Longint read FCurrent.X write SetCol;
  313.     property Color default clWindow;
  314.     property ColCount: Longint read FColCount write SetColCount default 5;
  315.     property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
  316.     property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
  317.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  318.     property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
  319.     property EditorMode: Boolean read FEditorMode write SetEditorMode;
  320.     property FixedColor: TColor read FFixedColor write SetFixedColor default clBtnFace;
  321.     property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
  322.     property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
  323.     property GridHeight: Integer read GetGridHeight;
  324.     property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
  325.     property GridWidth: Integer read GetGridWidth;
  326.     property HitTest: TPoint read FHitTest;
  327.     property InplaceEditor: TIvInplaceEdit read FInplaceEdit;
  328.     property LeftCol: Longint read FTopLeft.X write SetLeftCol;
  329.     property Options: TIvGridOptions read FOptions write SetOptions
  330.       default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  331.       goRangeSelect];
  332.     property ParentColor default False;
  333.     property Row: Longint read FCurrent.Y write SetRow;
  334.     property RowCount: Longint read FRowCount write SetRowCount default 5;
  335.     property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
  336.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  337.     property Selection: TIvGridRect read GetSelection write SetSelection;
  338.     property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
  339.     property TopRow: Longint read FTopLeft.Y write SetTopRow;
  340.     property VisibleColCount: Integer read GetVisibleColCount;
  341.     property VisibleRowCount: Integer read GetVisibleRowCount;
  342.  
  343.   public
  344.     constructor Create(AOwner: TComponent); override;
  345.     destructor Destroy; override;
  346.     function MouseCoord(X, Y: Integer): TIvGridCoord;
  347.  
  348.     property ColLocale[index: Integer]: Integer read GetColLocale write SetColLocale;
  349.  
  350.   published
  351.     property Locale: Integer read FLocale write SetLocale stored False;
  352.     property TabStop default True;
  353.   end;
  354.  
  355.   { TDrawGrid }
  356.  
  357.   TIvGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
  358.   TIvSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
  359.   TIvMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
  360.  
  361.   TIvDrawGrid = class(TIvCustomGrid)
  362.   private
  363.     FOnColumnMoved: TIvMovedEvent;
  364.     FOnDrawCell: TIvDrawCellEvent;
  365.     FOnGetEditMask: TIvGetEditEvent;
  366.     FOnGetEditText: TIvGetEditEvent;
  367.     FOnRowMoved: TIvMovedEvent;
  368.     FOnSelectCell: TIvSelectCellEvent;
  369.     FOnSetEditText: TIvSetEditEvent;
  370.     FOnTopLeftChanged: TNotifyEvent;
  371.  
  372.   protected
  373.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  374.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  375.       AState: TIvGridDrawState); override;
  376.     function GetEditMask(ACol, ARow: Longint): string; override;
  377.     function GetEditText(ACol, ARow: Longint): string; override;
  378.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  379.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  380.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  381.     procedure TopLeftChanged; override;
  382.  
  383.   public
  384.     function CellRect(ACol, ARow: Longint): TRect;
  385.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  386.     property Canvas;
  387.     property Col;
  388.     property ColWidths;
  389.     property EditorMode;
  390.     property GridHeight;
  391.     property GridWidth;
  392.     property LeftCol;
  393.     property Selection;
  394.     property Row;
  395.     property RowHeights;
  396.     property TabStops;
  397.     property TopRow;
  398.  
  399.   published
  400.     property Align;
  401.     property BorderStyle;
  402.     property Color;
  403.     property ColCount;
  404.     property Ctl3D;
  405.     property DefaultColWidth;
  406.     property DefaultRowHeight;
  407.     property DefaultDrawing;
  408.     property DragCursor;
  409.     property DragMode;
  410.     property Enabled;
  411.     property FixedColor;
  412.     property FixedCols;
  413.     property RowCount;
  414.     property FixedRows;
  415.     property Font;
  416.     property GridLineWidth;
  417.     property Options;
  418.     property ParentColor;
  419.     property ParentCtl3D;
  420.     property ParentFont;
  421.     property ParentShowHint;
  422.     property PopupMenu;
  423.     property ScrollBars;
  424.     property ShowHint;
  425.     property TabOrder;
  426.     property TabStop;
  427.     property Visible;
  428.     property VisibleColCount;
  429.     property VisibleRowCount;
  430.     property OnClick;
  431.     property OnColumnMoved: TIvMovedEvent read FOnColumnMoved write FOnColumnMoved;
  432.     property OnDblClick;
  433.     property OnDragDrop;
  434.     property OnDragOver;
  435.     property OnDrawCell: TIvDrawCellEvent read FOnDrawCell write FOnDrawCell;
  436.     property OnEndDrag;
  437.     property OnEnter;
  438.     property OnExit;
  439.     property OnGetEditMask: TIvGetEditEvent read FOnGetEditMask write FOnGetEditMask;
  440.     property OnGetEditText: TIvGetEditEvent read FOnGetEditText write FOnGetEditText;
  441.     property OnKeyDown;
  442.     property OnKeyPress;
  443.     property OnKeyUp;
  444.     property OnMouseDown;
  445.     property OnMouseMove;
  446.     property OnMouseUp;
  447.     property OnRowMoved: TIvMovedEvent read FOnRowMoved write FOnRowMoved;
  448.     property OnSelectCell: TIvSelectCellEvent read FOnSelectCell write FOnSelectCell;
  449.     property OnSetEditText: TIvSetEditEvent read FOnSetEditText write FOnSetEditText;
  450.     property OnStartDrag;
  451.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  452.   end;
  453.  
  454.   { TIvStringGrid }
  455.  
  456.   TIvStringGrid = class;
  457.  
  458.   TIvStringGridStrings = class(TStrings)
  459.   private
  460.     FGrid: TIvStringGrid;
  461.     FIndex: Integer;
  462.  
  463.     procedure CalcXY(Index: Integer; var X, Y: Integer);
  464.  
  465.   protected
  466.     function Get(Index: Integer): string; override;
  467.     function GetCount: Integer; override;
  468.     function GetObject(Index: Integer): TObject; override;
  469.     procedure Put(Index: Integer; const S: string); override;
  470.     procedure PutObject(Index: Integer; AObject: TObject); override;
  471.     procedure SetUpdateState(Updating: Boolean); override;
  472.  
  473.   public
  474.     constructor Create(AGrid: TIvStringGrid; AIndex: Longint);
  475.  
  476.     procedure Clear; override;
  477.     function Add(const S: string): Integer; override;
  478.  
  479.     procedure Assign(Source: TPersistent); override;
  480. {$IFDEF IVWIDE}
  481.     procedure Delete(Index: Integer); override;
  482.     procedure Insert(Index: Integer; const S: string); override;
  483. {$ENDIF}
  484.   end;
  485.  
  486.   TIvStringGrid = class(TIvDrawGrid)
  487.   private
  488.     FData: Pointer;
  489.     FRows: Pointer;
  490.     FCols: Pointer;
  491.     FUpdating: Boolean;
  492.     FNeedsUpdating: Boolean;
  493.     FEditUpdate: Integer;
  494.  
  495.     procedure DisableEditUpdate;
  496.     procedure EnableEditUpdate;
  497.     procedure Initialize;
  498.     procedure UpdateCell(ACol, ARow: Integer);
  499.     procedure SetUpdateState(Updating: Boolean);
  500.     function GetCells(ACol, ARow: Integer): string;
  501.     function GetCols(Index: Integer): TStrings;
  502.     function GetObjects(ACol, ARow: Integer): TObject;
  503.     function GetRows(Index: Integer): TStrings;
  504.     procedure SetCells(ACol, ARow: Integer; const Value: string);
  505.     procedure SetCols(Index: Integer; Value: TStrings);
  506.     procedure SetObjects(ACol, ARow: Integer; Value: TObject);
  507.     procedure SetRows(Index: Integer; Value: TStrings);
  508.     function EnsureColRow(Index: Integer; IsCol: Boolean): TIvStringGridStrings;
  509.     function EnsureDataRow(ARow: Integer): Pointer;
  510.  
  511.   protected
  512.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  513.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  514.       AState: TIvGridDrawState); override;
  515.     function GetEditText(ACol, ARow: Longint): string; override;
  516.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  517.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  518.  
  519.   public
  520.     constructor Create(AOwner: TComponent); override;
  521.     destructor Destroy; override;
  522.  
  523.     property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
  524.     property Cols[Index: Integer]: TStrings read GetCols write SetCols;
  525.     property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
  526.     property Rows[Index: Integer]: TStrings read GetRows write SetRows;
  527.   end;
  528. {$ENDIF}
  529.  
  530. implementation
  531.  
  532. {$IFNDEF IVBIDI}
  533. uses
  534.   Consts, IvDictio;
  535.  
  536. type
  537.   PIntArray = ^TIntArray;
  538.   TIntArray = array[0..IvMaxCustomExtents] of Integer;
  539.  
  540. {$IFDEF IVWIDE}
  541. procedure InvalidOp(const id: String);
  542. begin
  543.   raise EIvInvalidGridOperation.Create(id);
  544. end;
  545. {$ELSE}
  546. procedure InvalidOp(const id: Integer);
  547. begin
  548.   raise EIvInvalidGridOperation.CreateRes(id);
  549. end;
  550. {$ENDIF}
  551.  
  552. function IMin(A, B: Integer): Integer;
  553. begin
  554.   Result := B;
  555.   if A < B then Result := A;
  556. end;
  557.  
  558. function IMax(A, B: Integer): Integer;
  559. begin
  560.   Result := B;
  561.   if A > B then Result := A;
  562. end;
  563.  
  564. function GridRect(Coord1, Coord2: TIvGridCoord): TIvGridRect;
  565. begin
  566.   with Result do
  567.   begin
  568.     Left := Coord2.X;
  569.     if Coord1.X < Coord2.X then
  570.       Left := Coord1.X;
  571.  
  572.     Right := Coord1.X;
  573.     if Coord1.X < Coord2.X then
  574.       Right := Coord2.X;
  575.  
  576.     Top := Coord2.Y;
  577.     if Coord1.Y < Coord2.Y then
  578.       Top := Coord1.Y;
  579.  
  580.     Bottom := Coord1.Y;
  581.     if Coord1.Y < Coord2.Y then
  582.       Bottom := Coord2.Y;
  583.   end;
  584. end;
  585.  
  586. function PointInGridRect(Col, Row: Longint; const Rect: TIvGridRect): Boolean;
  587. begin
  588.   Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
  589.     and (Row <= Rect.Bottom);
  590. end;
  591.  
  592. type
  593.   TXorRects = array[0..3] of TRect;
  594.  
  595. procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
  596. var
  597.   Intersect, Union: TRect;
  598.  
  599.   function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  600.   begin
  601.     with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
  602.       (Y <= Bottom);
  603.   end;
  604.  
  605.   function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  606.   begin
  607.     with P1 do
  608.     begin
  609.       Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
  610.       if Result then P2 := P1;
  611.     end;
  612.   end;
  613.  
  614.   function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  615.   begin
  616.     Build := True;
  617.     with R do
  618.       if Includes(P1, TopLeft) then
  619.       begin
  620.         if not Includes(P3, BottomRight) then BottomRight := P2;
  621.       end
  622.       else if Includes(P2, TopLeft) then BottomRight := P3
  623.       else Build := False;
  624.   end;
  625.  
  626. begin
  627.   FillChar(XorRects, SizeOf(XorRects), 0);
  628.   if not Bool(IntersectRect(Intersect, R1, R2)) then
  629.   begin
  630.     { Don't intersect so its simple }
  631.     XorRects[0] := R1;
  632.     XorRects[1] := R2;
  633.   end
  634.   else
  635.   begin
  636.     UnionRect(Union, R1, R2);
  637.     if Build(XorRects[0],
  638.       Point(Union.Left, Union.Top),
  639.       Point(Union.Left, Intersect.Top),
  640.       Point(Union.Left, Intersect.Bottom)) then
  641.       XorRects[0].Right := Intersect.Left;
  642.     if Build(XorRects[1],
  643.       Point(Intersect.Left, Union.Top),
  644.       Point(Intersect.Right, Union.Top),
  645.       Point(Union.Right, Union.Top)) then
  646.       XorRects[1].Bottom := Intersect.Top;
  647.     if Build(XorRects[2],
  648.       Point(Union.Right, Intersect.Top),
  649.       Point(Union.Right, Intersect.Bottom),
  650.       Point(Union.Right, Union.Bottom)) then
  651.       XorRects[2].Left := Intersect.Right;
  652.     if Build(XorRects[3],
  653.       Point(Union.Left, Union.Bottom),
  654.       Point(Intersect.Left, Union.Bottom),
  655.       Point(Intersect.Right, Union.Bottom)) then
  656.       XorRects[3].Top := Intersect.Bottom;
  657.   end;
  658. end;
  659.  
  660. procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  661.   Default: Integer);
  662. var
  663.   LongSize: LongInt;
  664.   NewSize: Cardinal;
  665.   OldSize: Cardinal;
  666.   I: Cardinal;
  667. begin
  668.   if Amount <> 0 then
  669.   begin
  670.     if not Assigned(Extents) then OldSize := 0
  671.     else OldSize := PIntArray(Extents)^[0];
  672.     if (Index < 0) or (Integer(OldSize) < Index) then
  673.       InvalidOp(SIndexOutOfRange);
  674.     LongSize := Integer(OldSize) + Amount;
  675.     if LongSize < 0 then InvalidOp(STooManyDeleted)
  676.     else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
  677.     NewSize := Cardinal(LongSize);
  678.     if NewSize > 0 then Inc(NewSize);
  679.     ReallocMem(Extents, NewSize * SizeOf(Integer));
  680.     if Assigned(Extents) then
  681.     begin
  682.       I := Index;
  683.       while I < NewSize do
  684.       begin
  685.         PIntArray(Extents)^[I] := Default;
  686.         Inc(I);
  687.       end;
  688.       PIntArray(Extents)^[0] := NewSize-1;
  689.     end;
  690.   end;
  691. end;
  692.  
  693. procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  694.   Default: Integer);
  695. var
  696.   OldSize: Integer;
  697. begin
  698.   OldSize := 0;
  699.   if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
  700.   ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
  701. end;
  702.  
  703. procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
  704. var
  705.   Extent: Integer;
  706. begin
  707.   if Assigned(Extents) then
  708.   begin
  709.     Extent := PIntArray(Extents)^[FromIndex];
  710.     if FromIndex < ToIndex then
  711.       Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
  712.         (ToIndex - FromIndex) * SizeOf(Integer))
  713.     else if FromIndex > ToIndex then
  714.       Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
  715.         (FromIndex - ToIndex) * SizeOf(Integer));
  716.     PIntArray(Extents)^[ToIndex] := Extent;
  717.   end;
  718. end;
  719.  
  720. function CompareExtents(E1, E2: Pointer): Boolean;
  721. var
  722.   I: Integer;
  723. begin
  724.   Result := False;
  725.   if E1 <> nil then
  726.   begin
  727.     if E2 <> nil then
  728.     begin
  729.       for I := 0 to PIntArray(E1)^[0] do
  730.         if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
  731.       Result := True;
  732.     end
  733.   end
  734.   else Result := E2 = nil;
  735. end;
  736.  
  737. { Private. LongMulDiv multiplys the first two arguments and then
  738.   divides by the third.  This is used so that real number
  739.   (floating point) arithmetic is not necessary.  This routine saves
  740.   the possible 64-bit value in a temp before doing the divide.  Does
  741.   not do error checking like divide by zero.  Also assumes that the
  742.   result is in the 32-bit range (Actually 31-bit, since this algorithm
  743.   is for unsigned). }
  744.  
  745. function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  746.   external 'kernel32.dll' name 'MulDiv';
  747.  
  748. type
  749.   TSelection = record
  750.     StartPos, EndPos: Integer;
  751.   end;
  752.  
  753. constructor TIvInplaceEdit.Create(AOwner: TComponent);
  754. begin
  755.   inherited Create(AOwner);
  756.   ParentCtl3D := False;
  757.   Ctl3D := False;
  758.   TabStop := False;
  759.   BorderStyle := bsNone;
  760. end;
  761.  
  762. procedure TIvInplaceEdit.CreateParams(var Params: TCreateParams);
  763. begin
  764.   inherited CreateParams(Params);
  765.   Params.Style := Params.Style or ES_MULTILINE;
  766. end;
  767.  
  768. procedure TIvInplaceEdit.SetGrid(Value: TIvCustomGrid);
  769. begin
  770.   FGrid := Value;
  771. end;
  772.  
  773. procedure TIvInplaceEdit.CMShowingChanged(var Message: TMessage);
  774. begin
  775.   { Ignore showing using the Visible property }
  776. end;
  777.  
  778. procedure TIvInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  779. begin
  780.   inherited;
  781.   if goTabs in Grid.Options then
  782.     Message.Result := Message.Result or DLGC_WANTTAB;
  783. end;
  784.  
  785. procedure TIvInplaceEdit.WMPaste(var Message);
  786. begin
  787.   if not EditCanModify then Exit;
  788.   inherited
  789. end;
  790.  
  791. procedure TIvInplaceEdit.WMClear(var Message);
  792. begin
  793.   if not EditCanModify then Exit;
  794.   inherited;
  795. end;
  796.  
  797. procedure TIvInplaceEdit.WMCut(var Message);
  798. begin
  799.   if not EditCanModify then Exit;
  800.   inherited;
  801. end;
  802.  
  803. procedure TIvInplaceEdit.DblClick;
  804. begin
  805.   Grid.DblClick;
  806. end;
  807.  
  808. function TIvInplaceEdit.EditCanModify: Boolean;
  809. begin
  810.   Result := Grid.CanEditModify;
  811. end;
  812.  
  813. procedure TIvInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  814.  
  815.   procedure SendToParent;
  816.   begin
  817.     Grid.KeyDown(Key, Shift);
  818.     Key := 0;
  819.   end;
  820.  
  821.   procedure ParentEvent;
  822.   var
  823.     GridKeyDown: TKeyEvent;
  824.   begin
  825.     GridKeyDown := Grid.OnKeyDown;
  826.     if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
  827.   end;
  828.  
  829.   function ForwardMovement: Boolean;
  830.   begin
  831.     Result := goAlwaysShowEditor in Grid.Options;
  832.   end;
  833.  
  834.   function Ctrl: Boolean;
  835.   begin
  836.     Result := ssCtrl in Shift;
  837.   end;
  838.  
  839.   function Selection: TSelection;
  840.   begin
  841.     SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  842.   end;
  843.  
  844.   function RightSide: Boolean;
  845.   begin
  846.     with Selection do
  847.       Result := ((StartPos = 0) or (EndPos = StartPos)) and
  848.         (EndPos = GetTextLen);
  849.    end;
  850.  
  851.   function LeftSide: Boolean;
  852.   begin
  853.     with Selection do
  854.       Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  855.   end;
  856.  
  857. begin
  858.   case Key of
  859.     VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_ESCAPE: SendToParent;
  860.     VK_INSERT:
  861.       if Shift = [] then SendToParent
  862.       else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
  863.     VK_LEFT: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  864.     VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  865.     VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  866.     VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  867.     VK_F2:
  868.       begin
  869.         ParentEvent;
  870.         if Key = VK_F2 then
  871.         begin
  872.           Deselect;
  873.           Exit;
  874.         end;
  875.       end;
  876.     VK_TAB: if not (ssAlt in Shift) then SendToParent;
  877.   end;
  878.   if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
  879.   if Key <> 0 then
  880.   begin
  881.     ParentEvent;
  882.     inherited KeyDown(Key, Shift);
  883.   end;
  884. end;
  885.  
  886. procedure TIvInplaceEdit.KeyPress(var Key: Char);
  887. var
  888.   Selection: TSelection;
  889. begin
  890.   Grid.KeyPress(Key);
  891.   if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
  892.   begin
  893.     Key := #0;
  894.     MessageBeep(0);
  895.   end;
  896.   case Key of
  897.     #9, #27: Key := #0;
  898.     #13:
  899.       begin
  900.         SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  901.         if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
  902.           Deselect else
  903.           SelectAll;
  904.         Key := #0;
  905.       end;
  906.     ^H, ^V, ^X, #32..#255:
  907.       if not Grid.CanEditModify then Key := #0;
  908.   end;
  909.   if Key <> #0 then inherited KeyPress(Key);
  910. end;
  911.  
  912. procedure TIvInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
  913. begin
  914.   Grid.KeyUp(Key, Shift);
  915. end;
  916.  
  917. procedure TIvInplaceEdit.WndProc(var Message: TMessage);
  918. begin
  919.   case Message.Msg of
  920.     WM_SETFOCUS:
  921.       begin
  922.         if (GetParentForm(Self) = nil) or GetParentForm(Self).SetFocusedControl(Grid) then Dispatch(Message);
  923.         Exit;
  924.       end;
  925.     WM_LBUTTONDOWN:
  926.       begin
  927.         if GetMessageTime - FClickTime < GetDoubleClickTime then
  928.           Message.Msg := WM_LBUTTONDBLCLK;
  929.         FClickTime := 0;
  930.       end;
  931.   end;
  932.   inherited WndProc(Message);
  933. end;
  934.  
  935. procedure TIvInplaceEdit.Deselect;
  936. begin
  937.   SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
  938. end;
  939.  
  940. procedure TIvInplaceEdit.Invalidate;
  941. var
  942.   Cur: TRect;
  943. begin
  944.   ValidateRect(Handle, nil);
  945.   InvalidateRect(Handle, nil, True);
  946.   Windows.GetClientRect(Handle, Cur);
  947.   MapWindowPoints(Handle, Grid.Handle, Cur, 2);
  948.   ValidateRect(Grid.Handle, @Cur);
  949.   InvalidateRect(Grid.Handle, @Cur, False);
  950. end;
  951.  
  952. procedure TIvInplaceEdit.Hide;
  953. begin
  954.   if HandleAllocated and IsWindowVisible(Handle) then
  955.   begin
  956.     Invalidate;
  957.     SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
  958.       SWP_NOREDRAW);
  959.     if Focused then Windows.SetFocus(Grid.Handle);
  960.   end;
  961. end;
  962.  
  963. function TIvInplaceEdit.PosEqual(const Rect: TRect): Boolean;
  964. var
  965.   Cur: TRect;
  966. begin
  967.   GetWindowRect(Handle, Cur);
  968.   MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
  969.   Result := EqualRect(Rect, Cur);
  970. end;
  971.  
  972. procedure TIvInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
  973. begin
  974.   if IsRectEmpty(Loc) then Hide
  975.   else
  976.   begin
  977.     CreateHandle;
  978.     Redraw := Redraw or not IsWindowVisible(Handle);
  979.     Invalidate;
  980.     with Loc do
  981.       SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
  982.         SWP_SHOWWINDOW or SWP_NOREDRAW);
  983.     BoundsChanged;
  984.     if Redraw then Invalidate;
  985.     if Grid.Focused then
  986.       Windows.SetFocus(Handle);
  987.   end;
  988. end;
  989.  
  990. procedure TIvInplaceEdit.BoundsChanged;
  991. var
  992.   R: TRect;
  993. begin
  994.   R := Rect(2, 2, Width - 2, Height);
  995.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  996.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  997. end;
  998.  
  999. procedure TIvInplaceEdit.UpdateLoc(const Loc: TRect);
  1000. begin
  1001.   InternalMove(Loc, False);
  1002. end;
  1003.  
  1004. procedure TIvInplaceEdit.UpdateBidi(value: Boolean);
  1005. var
  1006.   style, newStyle: Integer;
  1007. begin
  1008.   { Extended style }
  1009.  
  1010.   style := GetWindowLong(Handle, GWL_EXSTYLE);
  1011.   if value then
  1012.     newStyle := style or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR or WS_EX_RTLREADING
  1013.   else
  1014.     newStyle := style and not (WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR or WS_EX_RTLREADING);
  1015.   if newStyle <> style then
  1016.     SetWindowLong(Handle, GWL_EXSTYLE, newStyle);
  1017. end;
  1018.  
  1019. function TIvInplaceEdit.Visible: Boolean;
  1020. begin
  1021.   Result := IsWindowVisible(Handle);
  1022. end;
  1023.  
  1024. procedure TIvInplaceEdit.Move(const Loc: TRect);
  1025. begin
  1026.   InternalMove(Loc, True);
  1027. end;
  1028.  
  1029. procedure TIvInplaceEdit.SetFocus;
  1030. begin
  1031.   if IsWindowVisible(Handle) then
  1032.     Windows.SetFocus(Handle);
  1033. end;
  1034.  
  1035. procedure TIvInplaceEdit.UpdateContents;
  1036. begin
  1037.   Text := '';
  1038.   EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  1039.   Text := Grid.GetEditText(Grid.Col, Grid.Row);
  1040.   MaxLength := Grid.GetEditLimit;
  1041. end;
  1042.  
  1043. { TIvCustomGrid }
  1044.  
  1045. constructor TIvCustomGrid.Create(AOwner: TComponent);
  1046. const
  1047.   GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
  1048. begin
  1049.   inherited Create(AOwner);
  1050.   if NewStyleControls then
  1051.     ControlStyle := GridStyle else
  1052.     ControlStyle := GridStyle + [csFramed];
  1053.   FCanEditModify := True;
  1054.   FColCount := 5;
  1055.   FRowCount := 5;
  1056.   FFixedCols := 1;
  1057.   FFixedRows := 1;
  1058.   FGridLineWidth := 1;
  1059.   FOptions := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  1060.     goRangeSelect];
  1061.   DesignOptionsBoost := [goColSizing, goRowSizing];
  1062.   FFixedColor := clBtnFace;
  1063.   FScrollBars := ssBoth;
  1064.   FBorderStyle := bsSingle;
  1065.   FDefaultColWidth := 64;
  1066.   FDefaultRowHeight := 24;
  1067.   FDefaultDrawing := True;
  1068.   FSaveCellExtents := True;
  1069.   FEditorMode := False;
  1070.  
  1071.   FLocale := 0;
  1072.   FColLocale := TList.Create;
  1073.   while FColLocale.Count < FColCount do
  1074.     FColLocale.Add(Pointer(0));
  1075.  
  1076.   Color := clWindow;
  1077.   ParentColor := False;
  1078.   TabStop := True;
  1079.   SetBounds(
  1080.     Left,
  1081.     Top,
  1082.     FColCount*FDefaultColWidth,
  1083.     FRowCount*FDefaultRowHeight);
  1084.   Initialize;
  1085. end;
  1086.  
  1087. destructor TIvCustomGrid.Destroy;
  1088. begin
  1089.   while FColLocale.Count > 0 do
  1090.     FColLocale.Delete(0);
  1091.   FColLocale.Free;
  1092.  
  1093.   FInplaceEdit.Free;
  1094.   inherited Destroy;
  1095.   FreeMem(FColWidths);
  1096.   FreeMem(FRowHeights);
  1097.   FreeMem(FTabStops);
  1098. end;
  1099.  
  1100. procedure TIvCustomGrid.SetLocale(value: Integer);
  1101. begin
  1102.   if value <> FLocale then
  1103.   begin
  1104.     FLocale := value;
  1105.     Invalidate;
  1106.   end;
  1107. end;
  1108.  
  1109. function TIvCustomGrid.GetColLocale(index: Integer): Integer;
  1110. begin
  1111.   Result := Integer(FColLocale[index]);
  1112.   if Result = 0 then
  1113.     Result := Locale;
  1114. end;
  1115.  
  1116. procedure TIvCustomGrid.SetColLocale(index: Integer; value: Integer);
  1117. begin
  1118.   if value <> ColLocale[index] then
  1119.   begin
  1120.     FColLocale[index] := Pointer(value);
  1121.     Invalidate;
  1122.   end;
  1123. end;
  1124.  
  1125. procedure TIvCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
  1126. var
  1127.   NewCur: TIvGridCoord;
  1128.   OldRows, OldCols: Longint;
  1129.   MovementX, MovementY: Longint;
  1130.   MoveRect: TIvGridRect;
  1131.   ScrollArea: TRect;
  1132.   AbsAmount: Longint;
  1133.  
  1134.   function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
  1135.     DefaultExtent: Integer; var Current: Longint): Longint;
  1136.   var
  1137.     I: Integer;
  1138.     NewCount: Longint;
  1139.   begin
  1140.     NewCount := Count + Amount;
  1141.     if NewCount < Index then InvalidOp(STooManyDeleted);
  1142.     if (Amount < 0) and Assigned(Extents) then
  1143.     begin
  1144.       Result := 0;
  1145.       for I := Index to Index - Amount - 1 do
  1146.         Inc(Result, PIntArray(Extents)^[I]);
  1147.     end
  1148.     else
  1149.       Result := Amount * DefaultExtent;
  1150.     if Extents <> nil then
  1151.       ModifyExtents(Extents, Index, Amount, DefaultExtent);
  1152.     Count := NewCount;
  1153.     if Current >= Index then
  1154.       if (Amount < 0) and (Current < Index - Amount) then Current := Index
  1155.       else Inc(Current, Amount);
  1156.   end;
  1157.  
  1158. begin
  1159.   if Amount = 0 then
  1160.     Exit;
  1161.   NewCur := FCurrent;
  1162.   OldCols := ColCount;
  1163.   OldRows := RowCount;
  1164.   MoveRect.Left := FixedCols;
  1165.   MoveRect.Right := ColCount - 1;
  1166.   MoveRect.Top := FixedRows;
  1167.   MoveRect.Bottom := RowCount - 1;
  1168.   MovementX := 0;
  1169.   MovementY := 0;
  1170.   AbsAmount := Amount;
  1171.   if AbsAmount < 0 then AbsAmount := -AbsAmount;
  1172.   if Rows then
  1173.   begin
  1174.     MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
  1175.     MoveRect.Top := Index;
  1176.     if Index + AbsAmount <= TopRow then
  1177.       MoveRect.Bottom := TopRow - 1;
  1178.   end
  1179.   else
  1180.   begin
  1181.     MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
  1182.     MoveRect.Left := Index;
  1183.     if Index + AbsAmount <= LeftCol then
  1184.       MoveRect.Right := LeftCol - 1;
  1185.   end;
  1186.   GridRectToScreenRect(MoveRect, ScrollArea, True);
  1187.   if not IsRectEmpty(ScrollArea) then
  1188.   begin
  1189.     ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
  1190.     UpdateWindow(Handle);
  1191.   end;
  1192.   SizeChanged(OldCols, OldRows);
  1193.   if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
  1194.     MoveCurrent(NewCur.X, NewCur.Y, True, True);
  1195. end;
  1196.  
  1197. function TIvCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  1198. var
  1199.   gridRect: TIvGridRect;
  1200. begin
  1201.   gridRect.Left := ALeft;
  1202.   gridRect.Right := ARight;
  1203.   gridRect.Top := ATop;
  1204.   gridRect.Bottom := ABottom;
  1205.   GridRectToScreenRect(gridRect, Result, False);
  1206. end;
  1207.  
  1208. procedure TIvCustomGrid.DoExit;
  1209. begin
  1210.   inherited DoExit;
  1211.   if not (goAlwaysShowEditor in Options) then
  1212.     HideEditor;
  1213. end;
  1214.  
  1215. function TIvCustomGrid.CellRect(ACol, ARow: Longint): TRect;
  1216. begin
  1217.   Result := BoxRect(ACol, ARow, ACol, ARow);
  1218. end;
  1219.  
  1220. function TIvCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
  1221. begin
  1222.   Result := True;
  1223. end;
  1224.  
  1225. function TIvCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
  1226. begin
  1227.   Result := True;
  1228. end;
  1229.  
  1230. function TIvCustomGrid.CanEditModify: Boolean;
  1231. begin
  1232.   Result := FCanEditModify;
  1233. end;
  1234.  
  1235. function TIvCustomGrid.CanEditShow: Boolean;
  1236. begin
  1237.   Result := ([goRowSelect, goEditing]*Options = [goEditing]) and
  1238.     FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
  1239.     ((goAlwaysShowEditor in Options) or IsActiveControl);
  1240. end;
  1241.  
  1242. function TIvCustomGrid.IsActiveControl: Boolean;
  1243. {$IFDEF IVWIDE}
  1244. var
  1245.   H: Hwnd;
  1246.   ParentForm: TCustomForm;
  1247. {$ENDIF}
  1248. begin
  1249. {$IFDEF IVWIDE}
  1250.   Result := False;
  1251.   ParentForm := GetParentForm(Self);
  1252.   if Assigned(ParentForm) then
  1253.   begin
  1254.     if (ParentForm.ActiveControl = Self) then
  1255.       Result := True
  1256.   end
  1257.   else
  1258.   begin
  1259.     H := GetFocus;
  1260.     while IsWindow(H) and (Result = False) do
  1261.     begin
  1262.       if H = WindowHandle then
  1263.         Result := True
  1264.       else
  1265.         H := GetParent(H);
  1266.     end;
  1267.   end;
  1268. {$ELSE}
  1269.   Result := ValidParentForm(Self).ActiveControl = Self;
  1270. {$ENDIF}
  1271. end;
  1272.  
  1273. function TIvCustomGrid.GetEditMask(ACol, ARow: Longint): string;
  1274. begin
  1275.   Result := '';
  1276. end;
  1277.  
  1278. function TIvCustomGrid.GetEditText(ACol, ARow: Longint): string;
  1279. begin
  1280.   Result := '';
  1281. end;
  1282.  
  1283. procedure TIvCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  1284. begin
  1285. end;
  1286.  
  1287. function TIvCustomGrid.GetEditLimit: Integer;
  1288. begin
  1289.   Result := 0;
  1290. end;
  1291.  
  1292. procedure TIvCustomGrid.HideEditor;
  1293. begin
  1294.   FEditorMode := False;
  1295.   HideEdit;
  1296. end;
  1297.  
  1298. procedure TIvCustomGrid.ShowEditor;
  1299. begin
  1300.   FEditorMode := True;
  1301.   UpdateEdit;
  1302. end;
  1303.  
  1304. procedure TIvCustomGrid.ShowEditorChar(Ch: Char);
  1305. begin
  1306.   ShowEditor;
  1307.   if FInplaceEdit <> nil then
  1308.     PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0);
  1309. end;
  1310.  
  1311. procedure TIvCustomGrid.InvalidateEditor;
  1312. begin
  1313.   FInplaceCol := -1;
  1314.   FInplaceRow := -1;
  1315.   UpdateEdit;
  1316. end;
  1317.  
  1318. procedure TIvCustomGrid.ReadColWidths(Reader: TReader);
  1319. var
  1320.   I: Integer;
  1321. begin
  1322.   with Reader do
  1323.   begin
  1324.     ReadListBegin;
  1325.     for I := 0 to ColCount - 1 do ColWidths[I] := ReadInteger;
  1326.     ReadListEnd;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure TIvCustomGrid.ReadRowHeights(Reader: TReader);
  1331. var
  1332.   I: Integer;
  1333. begin
  1334.   with Reader do
  1335.   begin
  1336.     ReadListBegin;
  1337.     for I := 0 to RowCount - 1 do RowHeights[I] := ReadInteger;
  1338.     ReadListEnd;
  1339.   end;
  1340. end;
  1341.  
  1342. procedure TIvCustomGrid.WriteColWidths(Writer: TWriter);
  1343. var
  1344.   I: Integer;
  1345. begin
  1346.   with Writer do
  1347.   begin
  1348.     WriteListBegin;
  1349.     for I := 0 to ColCount - 1 do WriteInteger(ColWidths[I]);
  1350.     WriteListEnd;
  1351.   end;
  1352. end;
  1353.  
  1354. procedure TIvCustomGrid.WriteRowHeights(Writer: TWriter);
  1355. var
  1356.   I: Integer;
  1357. begin
  1358.   with Writer do
  1359.   begin
  1360.     WriteListBegin;
  1361.     for I := 0 to RowCount - 1 do WriteInteger(RowHeights[I]);
  1362.     WriteListEnd;
  1363.   end;
  1364. end;
  1365.  
  1366. procedure TIvCustomGrid.DefineProperties(Filer: TFiler);
  1367.  
  1368.   function DoColWidths: Boolean;
  1369.   begin
  1370.     if Filer.Ancestor <> nil then
  1371.       Result := not CompareExtents(TIvCustomGrid(Filer.Ancestor).FColWidths, FColWidths)
  1372.     else
  1373.       Result := FColWidths <> nil;
  1374.   end;
  1375.  
  1376.   function DoRowHeights: Boolean;
  1377.   begin
  1378.     if Filer.Ancestor <> nil then
  1379.       Result := not CompareExtents(TIvCustomGrid(Filer.Ancestor).FRowHeights, FRowHeights)
  1380.     else
  1381.       Result := FRowHeights <> nil;
  1382.   end;
  1383.  
  1384.  
  1385. begin
  1386.   inherited DefineProperties(Filer);
  1387.   if FSaveCellExtents then
  1388.     with Filer do
  1389.     begin
  1390.       DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColWidths);
  1391.       DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowHeights);
  1392.     end;
  1393. end;
  1394.  
  1395. procedure TIvCustomGrid.MoveColumn(FromIndex, ToIndex: Longint);
  1396. var
  1397.   Rect: TIvGridRect;
  1398. begin
  1399.   if FromIndex = ToIndex then
  1400.     Exit;
  1401.  
  1402.   if Assigned(FColWidths) then
  1403.   begin
  1404.     MoveExtent(FColWidths, FromIndex + 1, ToIndex + 1);
  1405.     MoveExtent(FTabStops, FromIndex + 1, ToIndex + 1);
  1406.   end;
  1407.   MoveAdjust(FCurrent.X, FromIndex, ToIndex);
  1408.   MoveAdjust(FAnchor.X, FromIndex, ToIndex);
  1409.   MoveAdjust(FInplaceCol, FromIndex, ToIndex);
  1410.   Rect.Top := 0;
  1411.   Rect.Bottom := VisibleRowCount;
  1412.   if FromIndex < ToIndex then
  1413.   begin
  1414.     Rect.Left := FromIndex;
  1415.     Rect.Right := ToIndex;
  1416.   end
  1417.   else
  1418.   begin
  1419.     Rect.Left := ToIndex;
  1420.     Rect.Right := FromIndex;
  1421.   end;
  1422.   InvalidateRect(Rect);
  1423.   ColumnMoved(FromIndex, ToIndex);
  1424.   if Assigned(FColWidths) then
  1425.     ColWidthsChanged;
  1426.   UpdateEdit;
  1427. end;
  1428.  
  1429. procedure TIvCustomGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1430. begin
  1431. end;
  1432.  
  1433. procedure TIvCustomGrid.MoveRow(FromIndex, ToIndex: Longint);
  1434. begin
  1435.   if Assigned(FRowHeights) then
  1436.     MoveExtent(FRowHeights, FromIndex + 1, ToIndex + 1);
  1437.   MoveAdjust(FCurrent.Y, FromIndex, ToIndex);
  1438.   MoveAdjust(FAnchor.Y, FromIndex, ToIndex);
  1439.   MoveAdjust(FInplaceRow, FromIndex, ToIndex);
  1440.   RowMoved(FromIndex, ToIndex);
  1441.   if Assigned(FRowHeights) then
  1442.     RowHeightsChanged;
  1443.   UpdateEdit;
  1444. end;
  1445.  
  1446. procedure TIvCustomGrid.RowMoved(FromIndex, ToIndex: Longint);
  1447. begin
  1448. end;
  1449.  
  1450. function TIvCustomGrid.MouseCoord(X, Y: Integer): TIvGridCoord;
  1451. var
  1452.   DrawInfo: TIvGridDrawInfo;
  1453. begin
  1454.   CalcDrawInfo(DrawInfo);
  1455.   Result := CalcCoordFromPoint(X, Y, DrawInfo);
  1456.   if Result.X < 0 then Result.Y := -1
  1457.   else if Result.Y < 0 then Result.X := -1;
  1458. end;
  1459.  
  1460. procedure TIvCustomGrid.MoveColRow(ACol, ARow: Longint; MoveAnchor,
  1461.   Show: Boolean);
  1462. begin
  1463.   MoveCurrent(ACol, ARow, MoveAnchor, Show);
  1464. end;
  1465.  
  1466. function TIvCustomGrid.SelectCell(ACol, ARow: Longint): Boolean;
  1467. begin
  1468.   Result := True;
  1469. end;
  1470.  
  1471. procedure TIvCustomGrid.SizeChanged(OldColCount, OldRowCount: Longint);
  1472. begin
  1473. end;
  1474.  
  1475. function TIvCustomGrid.Sizing(X, Y: Integer): Boolean;
  1476. var
  1477.   DrawInfo: TIvGridDrawInfo;
  1478.   State: TIvGridState;
  1479.   Index: Longint;
  1480.   Pos, Ofs: Integer;
  1481. begin
  1482.   State := FGridState;
  1483.   if State = gsNormal then
  1484.   begin
  1485.     CalcDrawInfo(DrawInfo);
  1486.     CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  1487.   end;
  1488.   Result := State <> gsNormal;
  1489. end;
  1490.  
  1491. procedure TIvCustomGrid.TopLeftChanged;
  1492. begin
  1493.   if FEditorMode and (FInplaceEdit <> nil) then
  1494.     FInplaceEdit.UpdateLoc(CellRect(Col, Row));
  1495. end;
  1496.  
  1497. procedure FillDWord(var Dest; Count, Value: Integer); register;
  1498. asm
  1499.   XCHG  EDX, ECX
  1500.   PUSH  EDI
  1501.   MOV   EDI, EAX
  1502.   MOV   EAX, EDX
  1503.   REP   STOSD
  1504.   POP   EDI
  1505. end;
  1506.  
  1507. { StackAlloc allocates a 'small' block of memory from the stack by
  1508.   decrementing SP.  This provides the allocation speed of a local variable,
  1509.   but the runtime size flexibility of heap allocated memory.  }
  1510. function StackAlloc(Size: Integer): Pointer; register;
  1511. asm
  1512.   POP   ECX          { return address }
  1513.   MOV   EDX, ESP
  1514.   ADD   EAX, 3
  1515.   AND   EAX, not 3   // round up to keep ESP dword aligned
  1516.   CMP   EAX, 4092
  1517.   JLE   @@2
  1518. @@1:
  1519.   SUB   ESP, 4092
  1520.   PUSH  EAX          { make sure we touch guard page, to grow stack }
  1521.   SUB   EAX, 4096
  1522.   JNS   @@1
  1523.   ADD   EAX, 4096
  1524. @@2:
  1525.   SUB   ESP, EAX
  1526.   MOV   EAX, ESP     { function result = low memory address of block }
  1527.   PUSH  EDX          { save original SP, for cleanup }
  1528.   MOV   EDX, ESP
  1529.   SUB   EDX, 4
  1530.   PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
  1531.   PUSH  ECX          { return to caller }
  1532. end;
  1533.  
  1534. { StackFree pops the memory allocated by StackAlloc off the stack.
  1535. - Calling StackFree is optional - SP will be restored when the calling routine
  1536.   exits, but it's a good idea to free the stack allocated memory ASAP anyway.
  1537. - StackFree must be called in the same stack context as StackAlloc - not in
  1538.   a subroutine or finally block.
  1539. - Multiple StackFree calls must occur in reverse order of their corresponding
  1540.   StackAlloc calls.
  1541. - Built-in sanity checks guarantee that an improper call to StackFree will not
  1542.   corrupt the stack. Worst case is that the stack block is not released until
  1543.   the calling routine exits. }
  1544. procedure StackFree(P: Pointer); register;
  1545. asm
  1546.   POP   ECX                     { return address }
  1547.   MOV   EDX, DWORD PTR [ESP]
  1548.   SUB   EAX, 8
  1549.   CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
  1550.   JNE   @@1
  1551.   CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
  1552.   JNE   @@1
  1553.   MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
  1554. @@1:
  1555.   PUSH  ECX                     { return to caller }
  1556. end;
  1557.  
  1558. procedure TIvCustomGrid.Paint;
  1559. var
  1560.   LineColor: TColor;
  1561.   drawInfo: TIvGridDrawInfo;
  1562.   Sel: TIvGridRect;
  1563.   UpdateRect: TRect;
  1564.   FocRect: TRect;
  1565.   PointsList: PIntArray;
  1566.   StrokeList: PIntArray;
  1567.   MaxStroke: Integer;
  1568.   FrameFlags1, FrameFlags2: DWORD;
  1569.  
  1570.   procedure DrawLines(
  1571.     DoHorz, DoVert: Boolean;
  1572.     Col, Row: Longint;
  1573.     const CellBounds: array of Integer;
  1574.     OnColor, OffColor: TColor);
  1575.  
  1576.   { Cellbounds is 4 integers: StartX, StartY, StopX, StopY
  1577.     Horizontal lines:  MajorIndex = 0
  1578.     Vertical lines:    MajorIndex = 1 }
  1579.  
  1580.   const
  1581.     FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
  1582.  
  1583.     procedure DrawAxisLines(
  1584.       const AxisInfo: TIvGridAxisDrawInfo;
  1585.       horiz: Boolean;
  1586.       Cell, MajorIndex: Integer;
  1587.       UseOnColor: Boolean);
  1588.     var
  1589.       Line: Integer;
  1590.       LogBrush: TLOGBRUSH;
  1591.       Index: Integer;
  1592.       Points: PIntArray;
  1593.       StopMajor, StartMinor, StopMinor: Integer;
  1594.     begin
  1595.       with Canvas, AxisInfo do
  1596.       begin
  1597.         if EffectiveLineWidth <> 0 then
  1598.         begin
  1599.           Pen.Width := GridLineWidth;
  1600.           if UseOnColor then
  1601.             Pen.Color := OnColor
  1602.           else
  1603.             Pen.Color := OffColor;
  1604.           if Pen.Width > 1 then
  1605.           begin
  1606.             LogBrush.lbStyle := BS_Solid;
  1607.             LogBrush.lbColor := Pen.Color;
  1608.             LogBrush.lbHatch := 0;
  1609.             Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
  1610.           end;
  1611.           Points := PointsList;
  1612.           Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
  1613.             GetExtent(Cell);
  1614.           StartMinor := CellBounds[MajorIndex xor 1];
  1615.           StopMinor := CellBounds[2 + (MajorIndex xor 1)];
  1616.           StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
  1617.           Index := 0;
  1618.           repeat
  1619.             begin
  1620.               Points^[Index + MajorIndex] := Line;         { MoveTo }
  1621.               Points^[Index + (MajorIndex xor 1)] := StartMinor;
  1622.               Inc(Index, 2);
  1623.               Points^[Index + MajorIndex] := Line;         { LineTo }
  1624.               Points^[Index + (MajorIndex xor 1)] := StopMinor;
  1625.               Inc(Index, 2);
  1626.             end;
  1627.             Inc(Cell);
  1628.             Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
  1629.           until Line > StopMajor;
  1630.            { 2 integers per point, 2 points per line -> Index div 4 }
  1631.           PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
  1632.         end;
  1633.       end;
  1634.     end;
  1635.  
  1636.   begin
  1637.     if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then
  1638.       Exit;
  1639.  
  1640.     if not DoHorz then
  1641.     begin
  1642.       DrawAxisLines(DrawInfo.Vert, False, Row, 1, DoHorz);
  1643.       DrawAxisLines(DrawInfo.Horz, True, Col, 0, DoVert);
  1644.     end
  1645.     else
  1646.     begin
  1647.       DrawAxisLines(DrawInfo.Horz, True, Col, 0, DoVert);
  1648.       DrawAxisLines(DrawInfo.Vert, False, Row, 1, DoHorz);
  1649.     end;
  1650.   end;
  1651.  
  1652.   procedure DrawCells(
  1653.     aCol, aRow: Longint;
  1654.     startX, startY, stopX, stopY: Integer;
  1655.     color: TColor;
  1656.     includeDrawState: TIvGridDrawState);
  1657.   var
  1658.     curCol, curRow: Longint;
  1659.     where, tempRect: TRect;
  1660.     drawState: TIvGridDrawState;
  1661.     focused: Boolean;
  1662.   begin
  1663.     begin
  1664.       // Left-aligned grid
  1665.  
  1666.       curRow := aRow;
  1667.       where.Top := startY;
  1668.       while (where.Top < stopY) and (curRow < rowCount) do
  1669.       begin
  1670.         curCol := aCol;
  1671.         where.Left := StartX;
  1672.         where.Bottom := where.Top + RowHeights[CurRow];
  1673.  
  1674.         while (where.Left < stopX) and (curCol < colCount) do
  1675.         begin
  1676.           where.Right := where.Left + ColWidths[CurCol];
  1677.           if RectVisible(Canvas.Handle, Where) then
  1678.           begin
  1679.             DrawState := IncludeDrawState;
  1680.             Focused := IsActiveControl;
  1681.             if Focused and (CurRow = Row) and (CurCol = Col)  then
  1682.               Include(DrawState, gdFocused);
  1683.             if PointInGridRect(CurCol, CurRow, Sel) then
  1684.               Include(DrawState, gdSelected);
  1685.  
  1686.             if not (gdFocused in DrawState) or not (goEditing in Options) or
  1687.               not FEditorMode or (csDesigning in ComponentState) then
  1688.             begin
  1689.               if DefaultDrawing or (csDesigning in ComponentState) then
  1690.               begin
  1691.                 with Canvas do
  1692.                 begin
  1693.                   Font := Self.Font;
  1694.                   if (gdSelected in DrawState) and
  1695.                     (not (gdFocused in DrawState) or
  1696.                     ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
  1697.                   begin
  1698.                     Brush.Color := clHighlight;
  1699.                     Font.Color := clHighlightText;
  1700.                   end
  1701.                   else
  1702.                     Brush.Color := Color;
  1703.                   FillRect(where);
  1704.                 end;
  1705.               end;
  1706.  
  1707.               DrawCell(curCol, curRow, where, drawState);
  1708.  
  1709.               if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
  1710.                 ((FrameFlags1 or FrameFlags2) <> 0) then
  1711.               begin
  1712.                 tempRect := where;
  1713.                 if (FrameFlags1 and BF_RIGHT) = 0 then
  1714.                   Inc(tempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
  1715.                 else if (FrameFlags1 and BF_BOTTOM) = 0 then
  1716.                   Inc(tempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
  1717.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags1);
  1718.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags2);
  1719.               end;
  1720.  
  1721.               if DefaultDrawing and not (csDesigning in ComponentState) and
  1722.                 (gdFocused in DrawState) and
  1723.                 ([goEditing, goAlwaysShowEditor]*Options <> [goEditing, goAlwaysShowEditor]) and
  1724.                 not (goRowSelect in Options) then
  1725.               begin
  1726.                 DrawFocusRect(Canvas.Handle, where);
  1727.               end;
  1728.             end;
  1729.           end;
  1730.           where.Left := where.Right + drawInfo.Horz.EffectiveLineWidth;
  1731.           Inc(curCol);
  1732.         end;
  1733.         where.Top := where.Bottom + drawInfo.Vert.EffectiveLineWidth;
  1734.         Inc(curRow);
  1735.       end;
  1736.     end;
  1737.   end;
  1738.  
  1739. begin
  1740.   UpdateRect := Canvas.ClipRect;
  1741.   CalcDrawInfo(DrawInfo);
  1742.  
  1743.   if (drawInfo.Horz.EffectiveLineWidth > 0) or (drawInfo.Vert.EffectiveLineWidth > 0) then
  1744.   begin
  1745.     { Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
  1746.       (fixed, variable) and (variable, variable) }
  1747.  
  1748.     LineColor := clSilver;
  1749.     MaxStroke := IMax(drawInfo.Horz.LastFullVisibleCell - LeftCol + FixedCols,
  1750.                       drawInfo.Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
  1751.     PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
  1752.     StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
  1753.     FillDWord(StrokeList^, MaxStroke, 2);
  1754.  
  1755.     if ColorToRGB(Color) = clSilver then
  1756.       LineColor := clGray;
  1757.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1758.       0, 0, [0, 0, drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary], clBlack, FixedColor);
  1759.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1760.       LeftCol, 0, [drawInfo.Horz.FixedBoundary, 0, drawInfo.Horz.GridBoundary,
  1761.       drawInfo.Vert.FixedBoundary], clBlack, FixedColor);
  1762.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1763.       0, TopRow, [0, drawInfo.Vert.FixedBoundary, drawInfo.Horz.FixedBoundary,
  1764.       drawInfo.Vert.GridBoundary], clBlack, FixedColor);
  1765.     DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
  1766.       TopRow, [drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary, drawInfo.Horz.GridBoundary,
  1767.       drawInfo.Vert.GridBoundary], LineColor, Color);
  1768.  
  1769.     StackFree(StrokeList);
  1770.     StackFree(PointsList);
  1771.   end;
  1772.  
  1773.   { Draw the cells in the four areas }
  1774.   Sel := Selection;
  1775.   FrameFlags1 := 0;
  1776.   FrameFlags2 := 0;
  1777.   if goFixedVertLine in Options then
  1778.   begin
  1779.     FrameFlags1 := BF_RIGHT;
  1780.     FrameFlags2 := BF_LEFT;
  1781.   end;
  1782.   if goFixedHorzLine in Options then
  1783.   begin
  1784.     FrameFlags1 := FrameFlags1 or BF_BOTTOM;
  1785.     FrameFlags2 := FrameFlags2 or BF_TOP;
  1786.   end;
  1787.   DrawCells(0, 0, 0, 0, drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary, FixedColor,
  1788.     [gdFixed]);
  1789.   DrawCells(LeftCol, 0, drawInfo.Horz.FixedBoundary - FColOffset, 0, drawInfo.Horz.GridBoundary,  //!! clip
  1790.     drawInfo.Vert.FixedBoundary, FixedColor, [gdFixed]);
  1791.   DrawCells(0, TopRow, 0, drawInfo.Vert.FixedBoundary, drawInfo.Horz.FixedBoundary,
  1792.     drawInfo.Vert.GridBoundary, FixedColor, [gdFixed]);
  1793.   DrawCells(LeftCol, TopRow, drawInfo.Horz.FixedBoundary - FColOffset,                   //!! clip
  1794.     drawInfo.Vert.FixedBoundary, drawInfo.Horz.GridBoundary, drawInfo.Vert.GridBoundary, Color, []);
  1795.  
  1796.   if not (csDesigning in ComponentState) and
  1797.     (goRowSelect in Options) and DefaultDrawing and Focused then
  1798.   begin
  1799.     GridRectToScreenRect(GetSelection, FocRect, False);
  1800.     Canvas.DrawFocusRect(FocRect);
  1801.   end;
  1802.  
  1803.   { Fill in area not occupied by cells }
  1804.   if drawInfo.Horz.GridBoundary < drawInfo.Horz.GridExtent then
  1805.   begin
  1806.     Canvas.Brush.Color := Color;
  1807.       Canvas.FillRect(Rect(drawInfo.Horz.GridBoundary, 0, drawInfo.Horz.GridExtent, drawInfo.Vert.GridBoundary));
  1808.   end;
  1809.   if drawInfo.Vert.GridBoundary < drawInfo.Vert.GridExtent then
  1810.   begin
  1811.     Canvas.Brush.Color := Color;
  1812.     Canvas.FillRect(Rect(0, drawInfo.Vert.GridBoundary, drawInfo.Horz.GridExtent, drawInfo.Vert.GridExtent));
  1813.   end;
  1814. end;
  1815.  
  1816. function TIvCustomGrid.CalcCoordFromPoint(
  1817.   x, y: Integer;
  1818.   const drawInfo: TIvGridDrawInfo): TIvGridCoord;
  1819.  
  1820.   function DoCalc(const axisInfo: TIvGridAxisDrawInfo; n: Integer): Integer;
  1821.   var
  1822.     i, start, stop: Longint;
  1823.     line: Integer;
  1824.   begin
  1825.     begin
  1826.       if n < axisInfo.FixedBoundary then
  1827.       begin
  1828.         Start := 0;
  1829.         Stop := axisInfo.FixedCellCount - 1;
  1830.         Line := 0;
  1831.       end
  1832.       else
  1833.       begin
  1834.         Start := axisInfo.FirstGridCell;
  1835.         Stop := axisInfo.GridCellCount - 1;
  1836.         Line := axisInfo.FixedBoundary;
  1837.       end;
  1838.  
  1839.       Result := -1;
  1840.       for i := Start to Stop do
  1841.       begin
  1842.         Inc(line, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  1843.         if n < line then
  1844.         begin
  1845.           Result := i;
  1846.           Exit;
  1847.         end;
  1848.       end;
  1849.     end;
  1850.   end;
  1851.  
  1852. begin
  1853.   Result.X := DoCalc(drawInfo.Horz, x);
  1854.   Result.Y := DoCalc(drawInfo.Vert, y);
  1855. end;
  1856.  
  1857. procedure TIvCustomGrid.CalcDrawInfo(var DrawInfo: TIvGridDrawInfo);
  1858. begin
  1859.   CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
  1860. end;
  1861.  
  1862. procedure TIvCustomGrid.CalcDrawInfoXY(
  1863.   var drawInfo: TIvGridDrawInfo;
  1864.   useWidth, useHeight: Integer);
  1865.  
  1866.   procedure CalcAxis(var axisInfo: TIvGridAxisDrawInfo; useExtent: Integer);
  1867.   var
  1868.     i: Integer;
  1869.   begin
  1870.     axisInfo.GridExtent := useExtent;
  1871.     axisInfo.GridBoundary := axisInfo.FixedBoundary;
  1872.     axisInfo.FullVisBoundary := axisInfo.FixedBoundary;
  1873.     axisInfo.LastFullVisibleCell := axisInfo.FirstGridCell;
  1874.     for i := axisInfo.FirstGridCell to axisInfo.GridCellCount - 1 do
  1875.     begin
  1876.       Inc(axisInfo.GridBoundary, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  1877.       if axisInfo.GridBoundary > axisInfo.GridExtent + axisInfo.EffectiveLineWidth then
  1878.       begin
  1879.         axisInfo.GridBoundary := axisInfo.GridExtent;
  1880.         Break;
  1881.       end;
  1882.       axisInfo.LastFullVisibleCell := i;
  1883.       axisInfo.FullVisBoundary := axisInfo.GridBoundary;
  1884.     end;
  1885.   end;
  1886.  
  1887. begin
  1888.   drawInfo.Horz.AxisType := gaHorizontal;
  1889.   drawInfo.Vert.AxisType := gaVertical;
  1890.   CalcFixedInfo(drawInfo);
  1891.   CalcAxis(drawInfo.Horz, useWidth);
  1892.   CalcAxis(drawInfo.Vert, useHeight);
  1893. end;
  1894.  
  1895. procedure TIvCustomGrid.CalcFixedInfo(var drawInfo: TIvGridDrawInfo);
  1896.  
  1897.   procedure CalcFixedAxis(
  1898.     var axis: TIvGridAxisDrawInfo;
  1899.     lineOptions: TIvGridOptions;
  1900.     fixedCount, firstCell, cellCount: Integer;
  1901.     getExtentFunc: TIvGetExtentsFunc);
  1902.   var
  1903.     i: Integer;
  1904.   begin
  1905.     if lineOptions*options = [] then
  1906.       axis.EffectiveLineWidth := 0
  1907.     else
  1908.       axis.EffectiveLineWidth := GridLineWidth;
  1909.       
  1910.     axis.FixedBoundary := 0;
  1911.     for i := 0 to fixedCount - 1 do
  1912.       Inc(axis.FixedBoundary, GetExtentFunc(i) + axis.EffectiveLineWidth);
  1913.  
  1914.     axis.FixedCellCount := fixedCount;
  1915.     axis.FirstGridCell := firstCell;
  1916.     axis.GridCellCount := cellCount;
  1917.     axis.GetExtent := getExtentFunc;
  1918.   end;
  1919.  
  1920. begin
  1921.   CalcFixedAxis(
  1922.     drawInfo.Horz,
  1923.     [goFixedVertLine, goVertLine],
  1924.     fixedCols,
  1925.     leftCol,
  1926.     colCount,
  1927.     getColWidths);
  1928.   CalcFixedAxis(
  1929.     drawInfo.Vert,
  1930.     [goFixedHorzLine, goHorzLine],
  1931.     fixedRows,
  1932.     topRow,
  1933.     rowCount,
  1934.     getRowHeights);
  1935. end;
  1936.  
  1937. { Calculates the TopLeft that will put the given Coord in view }
  1938. function TIvCustomGrid.CalcMaxTopLeft(const Coord: TIvGridCoord;
  1939.   const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  1940.  
  1941.   function CalcMaxCell(const Axis: TIvGridAxisDrawInfo; Start: Integer): Integer;
  1942.   var
  1943.     Line: Integer;
  1944.     I: Longint;
  1945.   begin
  1946.     Result := Start;
  1947.     with Axis do
  1948.     begin
  1949.       Line := GridExtent + EffectiveLineWidth;
  1950.       for I := Start downto FixedCellCount do
  1951.       begin
  1952.         Dec(Line, GetExtent(I));
  1953.         Dec(Line, EffectiveLineWidth);
  1954.         if Line < FixedBoundary then Break;
  1955.         Result := I;
  1956.       end;
  1957.     end;
  1958.   end;
  1959.  
  1960. begin
  1961.   Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
  1962.   Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
  1963. end;
  1964.  
  1965. procedure TIvCustomGrid.CalcSizingState(
  1966.   x, y: Integer;
  1967.   var state: TIvGridState;
  1968.   var index: Longint;
  1969.   var sizingPos, sizingOfs: Integer;
  1970.   var fixedInfo: TIvGridDrawInfo);
  1971.  
  1972.   procedure CalcAxisState(
  1973.     const axisInfo: TIvGridAxisDrawInfo;
  1974.     pos: Integer;
  1975.     newState: TIvGridState);
  1976.   var
  1977.     i, line, back, range: Integer;
  1978.   begin
  1979.       line := axisInfo.FixedBoundary;
  1980.  
  1981.     range := axisInfo.EffectiveLineWidth;
  1982.     back := 0;
  1983.     if range < 7 then
  1984.     begin
  1985.       range := 7;
  1986.       back := (range - axisInfo.EffectiveLineWidth) shr 1;
  1987.     end;
  1988.  
  1989.     for i := axisInfo.FirstGridCell to axisInfo.GridCellCount - 1 do
  1990.     begin
  1991.         Inc(line, axisInfo.GetExtent(I));
  1992.  
  1993.       // If line is out of grid breaks
  1994.  
  1995.       begin
  1996.         if line > axisInfo.GridBoundary then
  1997.           Break;
  1998.       end;
  1999.  
  2000.       if (pos >= line - back) and (pos <= line - back + range) then
  2001.       begin
  2002.         state := newState;
  2003.         sizingPos := line;
  2004.         sizingOfs := line - pos;
  2005.         index := i;
  2006.         Exit;
  2007.       end;
  2008.  
  2009.         Inc(line, axisInfo.EffectiveLineWidth);
  2010.     end;
  2011.  
  2012.     if (axisInfo.GridBoundary = axisInfo.GridExtent) and
  2013.       (pos >= axisInfo.GridExtent - back) and
  2014.       (pos <= axisInfo.GridExtent) then
  2015.     begin
  2016.       state := newState;
  2017.       sizingPos := axisInfo.GridExtent;
  2018.       sizingOfs := axisInfo.GridExtent - pos;
  2019.       index := axisInfo.LastFullVisibleCell + 1;
  2020.     end;
  2021.   end;
  2022.  
  2023. var
  2024.   effectiveOptions: TIvGridOptions;
  2025. begin
  2026.   state := gsNormal;
  2027.   index := -1;
  2028.   effectiveOptions := Options;
  2029.   if csDesigning in ComponentState then
  2030.     effectiveOptions := effectiveOptions + DesignOptionsBoost;
  2031.  
  2032.   if [goColSizing, goRowSizing]*effectiveOptions <> [] then
  2033.   begin
  2034.     fixedInfo.Vert.GridExtent := ClientHeight;
  2035.     fixedInfo.Horz.GridExtent := ClientWidth;
  2036.     begin
  2037.       if (x > fixedInfo.Horz.FixedBoundary) and (goColSizing in effectiveOptions) then
  2038.       begin
  2039.         if y >= fixedInfo.Vert.FixedBoundary then
  2040.           Exit;
  2041.         CalcAxisState(fixedInfo.Horz, x, gsColSizing);
  2042.       end
  2043.       else if (y > fixedInfo.Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
  2044.       begin
  2045.         if x >= fixedInfo.Horz.FixedBoundary then
  2046.           Exit;
  2047.         CalcAxisState(fixedInfo.Vert, Y, gsRowSizing);
  2048.       end;
  2049.     end;
  2050.   end;
  2051. end;
  2052.  
  2053. procedure TIvCustomGrid.ChangeSize(NewColCount, NewRowCount: Longint);
  2054. var
  2055.   OldColCount, OldRowCount: Longint;
  2056.   OldDrawInfo: TIvGridDrawInfo;
  2057.  
  2058.   procedure MinRedraw(const OldInfo, NewInfo: TIvGridAxisDrawInfo; Axis: Integer);
  2059.   var
  2060.     R: TRect;
  2061.     First: Integer;
  2062.   begin
  2063.     if (OldInfo.LastFullVisibleCell = NewInfo.LastFullVisibleCell) then Exit;
  2064.     First := IMin(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
  2065.     // Get the rectangle around the leftmost or topmost cell in the target range.
  2066.     R := CellRect(First and not Axis, First and Axis);
  2067.     R.Bottom := Height;
  2068.     R.Right := Width;
  2069.     Windows.InvalidateRect(Handle, @R, False);
  2070.   end;
  2071.  
  2072.   procedure DoChange;
  2073.   var
  2074.     Coord: TIvGridCoord;
  2075.     NewDrawInfo: TIvGridDrawInfo;
  2076.   begin
  2077.     if FColWidths <> nil then
  2078.     begin
  2079.       UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  2080.       UpdateExtents(FTabStops, ColCount, Integer(True));
  2081.     end;
  2082.  
  2083.     if FRowHeights <> nil then
  2084.       UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  2085.  
  2086.     Coord := FCurrent;
  2087.     if Row >= RowCount then
  2088.       Coord.Y := RowCount - 1;
  2089.     if Col >= ColCount then
  2090.       Coord.X := ColCount - 1;
  2091.     if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
  2092.       MoveCurrent(Coord.X, Coord.Y, True, True);
  2093.     if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
  2094.       MoveAnchor(Coord);
  2095.     if VirtualView or
  2096.       (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
  2097.       (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
  2098.       InvalidateGrid
  2099.     else if HandleAllocated then
  2100.     begin
  2101.       CalcDrawInfo(NewDrawInfo);
  2102.       MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
  2103.       MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
  2104.     end;
  2105.     while FColLocale.Count < FColCount do
  2106.       FColLocale.Add(Pointer(0));
  2107.     UpdateScrollRange;
  2108.     SizeChanged(OldColCount, OldRowCount);
  2109.   end;
  2110.  
  2111. begin
  2112.   if HandleAllocated then
  2113.     CalcDrawInfo(OldDrawInfo);
  2114.   OldColCount := FColCount;
  2115.   OldRowCount := FRowCount;
  2116.   FColCount := NewColCount;
  2117.   FRowCount := NewRowCount;
  2118.   if FixedCols > NewColCount then FFixedCols := NewColCount - 1;
  2119.   if FixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
  2120.   try
  2121.     DoChange;
  2122.   except
  2123.     { Could not change size so try to clean up by setting the size back }
  2124.     FColCount := OldColCount;
  2125.     FRowCount := OldRowCount;
  2126.     DoChange;
  2127.     InvalidateGrid;
  2128.     raise;
  2129.   end;
  2130. end;
  2131.  
  2132. { Will move TopLeft so that Coord is in view }
  2133. procedure TIvCustomGrid.ClampInView(const Coord: TIvGridCoord);
  2134. var
  2135.   DrawInfo: TIvGridDrawInfo;
  2136.   MaxTopLeft: TIvGridCoord;
  2137.   OldTopLeft: TIvGridCoord;
  2138. begin
  2139.   if not HandleAllocated then Exit;
  2140.   CalcDrawInfo(DrawInfo);
  2141.   with DrawInfo, Coord do
  2142.   begin
  2143.     if (X > Horz.LastFullVisibleCell) or
  2144.       (Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then
  2145.     begin
  2146.       OldTopLeft := FTopLeft;
  2147.       MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
  2148.       Update;
  2149.       if X < LeftCol then FTopLeft.X := X
  2150.       else if X > Horz.LastFullVisibleCell then FTopLeft.X := MaxTopLeft.X;
  2151.       if Y < TopRow then FTopLeft.Y := Y
  2152.       else if Y > Vert.LastFullVisibleCell then FTopLeft.Y := MaxTopLeft.Y;
  2153.       TopLeftMoved(OldTopLeft);
  2154.     end;
  2155.   end;
  2156. end;
  2157.  
  2158. procedure TIvCustomGrid.DrawSizingLine(const DrawInfo: TIvGridDrawInfo);
  2159. var
  2160.   OldPen: TPen;
  2161. begin
  2162.   OldPen := TPen.Create;
  2163.   try
  2164.     with Canvas, DrawInfo do
  2165.     begin
  2166.       OldPen.Assign(Pen);
  2167.       Pen.Style := psDot;
  2168.       Pen.Mode := pmXor;
  2169.       Pen.Width := 1;
  2170.       try
  2171.         if FGridState = gsRowSizing then
  2172.         begin
  2173.           begin
  2174.             MoveTo(0, FSizingPos);
  2175.             LineTo(Horz.GridBoundary, FSizingPos);
  2176.           end;
  2177.         end
  2178.         else
  2179.         begin
  2180.           MoveTo(FSizingPos, 0);
  2181.           LineTo(FSizingPos, Vert.GridBoundary);
  2182.         end;
  2183.       finally
  2184.         Pen := OldPen;
  2185.       end;
  2186.     end;
  2187.   finally
  2188.     OldPen.Free;
  2189.   end;
  2190. end;
  2191.  
  2192. procedure TIvCustomGrid.DrawMove;
  2193. var
  2194.   OldPen: TPen;
  2195.   Pos: Integer;
  2196.   R: TRect;
  2197. begin
  2198.   OldPen := TPen.Create;
  2199.   try
  2200.     with Canvas do
  2201.     begin
  2202.       OldPen.Assign(Pen);
  2203.       try
  2204.         Pen.Style := psDot;
  2205.         Pen.Mode := pmXor;
  2206.         Pen.Width := 5;
  2207.         if FGridState = gsRowMoving then
  2208.         begin
  2209.           R := CellRect(0, FMovePos);
  2210.           if FMovePos > FMoveIndex then
  2211.             Pos := R.Bottom else
  2212.             Pos := R.Top;
  2213.           MoveTo(0, Pos);
  2214.           LineTo(ClientWidth, Pos);
  2215.         end
  2216.         else
  2217.         begin
  2218.           R := CellRect(FMovePos, 0);
  2219.           if FMovePos > FMoveIndex then
  2220.             Pos := R.Right else
  2221.             Pos := R.Left;
  2222.           MoveTo(Pos, 0);
  2223.           LineTo(Pos, ClientHeight);
  2224.         end;
  2225.       finally
  2226.         Canvas.Pen := OldPen;
  2227.       end;
  2228.     end;
  2229.   finally
  2230.     OldPen.Free;
  2231.   end;
  2232. end;
  2233.  
  2234. procedure TIvCustomGrid.FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  2235. begin
  2236.   MoveCurrent(ACol, ARow, MoveAnchor, True);
  2237.   UpdateEdit;
  2238.   Click;
  2239. end;
  2240.  
  2241. procedure TIvCustomGrid.GridRectToScreenRect(
  2242.   gridRect: TIvGridRect;
  2243.   var screenRect: TRect;
  2244.   includeLine: Boolean);
  2245.  
  2246.   function LinePos(const axisInfo: TIvGridAxisDrawInfo; line: Integer): Integer;
  2247.   var
  2248.     start, i: Longint;
  2249.   begin
  2250.     Result := 0;
  2251.     if line < axisInfo.FixedCellCount then
  2252.       Start := 0
  2253.     else
  2254.     begin
  2255.       if Line >= axisInfo.FirstGridCell then
  2256.         Result := axisInfo.FixedBoundary;
  2257.       Start := axisInfo.FirstGridCell;
  2258.     end;
  2259.  
  2260.     for I := Start to Line - 1 do
  2261.     begin
  2262.       Inc(Result, axisInfo.GetExtent(I) + axisInfo.EffectiveLineWidth);
  2263.       if Result > axisInfo.GridExtent then
  2264.       begin
  2265.         Result := 0;
  2266.         Exit;
  2267.       end;
  2268.     end;
  2269.   end;
  2270.  
  2271.   function CalcAxis(
  2272.     const axisInfo: TIvGridAxisDrawInfo;
  2273.     gridRectMin, gridRectMax: Integer;
  2274.     var screenRectMin, screenRectMax: Integer): Boolean;
  2275.   begin
  2276.     Result := False;
  2277.     if (GridRectMin >= axisInfo.FixedCellCount) and (GridRectMin < axisInfo.FirstGridCell) then
  2278.     begin
  2279.       if GridRectMax < axisInfo.FirstGridCell then
  2280.       begin
  2281.         FillChar(ScreenRect, SizeOf(ScreenRect), 0); { erase partial results }
  2282.         Exit;
  2283.       end
  2284.       else
  2285.         GridRectMin := axisInfo.FirstGridCell;
  2286.     end;
  2287.  
  2288.     if GridRectMax > axisInfo.LastFullVisibleCell then
  2289.     begin
  2290.       GridRectMax := axisInfo.LastFullVisibleCell;
  2291.       if GridRectMax < axisInfo.GridCellCount - 1 then
  2292.         Inc(GridRectMax);
  2293.       if LinePos(AxisInfo, GridRectMax) = 0 then
  2294.         Dec(GridRectMax);
  2295.     end;
  2296.  
  2297.     screenRectMin := LinePos(AxisInfo, GridRectMin);
  2298.     screenRectMax := LinePos(AxisInfo, GridRectMax);
  2299.     if screenRectMax = 0 then
  2300.       screenRectMax := screenRectMin + axisInfo.GetExtent(GridRectMin)
  2301.     else
  2302.       Inc(screenRectMax, axisInfo.GetExtent(GridRectMax));
  2303.  
  2304.     if screenRectMax > axisInfo.GridExtent then
  2305.       screenRectMax := axisInfo.GridExtent;
  2306.  
  2307.     if IncludeLine then
  2308.       Inc(screenRectMax, axisInfo.EffectiveLineWidth);
  2309.  
  2310.     Result := True;
  2311.   end;
  2312.  
  2313. var
  2314.   drawInfo: TIvGridDrawInfo;
  2315. begin
  2316.   FillChar(screenRect, SizeOf(screenRect), 0);
  2317.   if (gridRect.Left > gridRect.Right) or (gridRect.Top > gridRect.Bottom) then
  2318.     Exit;
  2319.   CalcDrawInfo(drawInfo);
  2320.  
  2321.   if gridRect.Left > drawInfo.Horz.LastFullVisibleCell + 1 then
  2322.     Exit;
  2323.   if gridRect.Top > drawInfo.Vert.LastFullVisibleCell + 1 then
  2324.     Exit;
  2325.  
  2326.   if CalcAxis(drawInfo.Horz, gridRect.Left, gridRect.Right, screenRect.Left, screenRect.Right) then
  2327.   begin
  2328.     CalcAxis(
  2329.       drawInfo.Vert,
  2330.       gridRect.Top,
  2331.       gridRect.Bottom,
  2332.       screenRect.Top,
  2333.       screenRect.Bottom);
  2334.   end;
  2335.  
  2336. end;
  2337.  
  2338. procedure TIvCustomGrid.Initialize;
  2339. begin
  2340.   FTopLeft.X := FixedCols;
  2341.   FTopLeft.Y := FixedRows;
  2342.   FCurrent := FTopLeft;
  2343.   FAnchor := FCurrent;
  2344.   if goRowSelect in Options then
  2345.     FAnchor.X := ColCount - 1;
  2346. end;
  2347.  
  2348. procedure TIvCustomGrid.InvalidateCell(ACol, ARow: Longint);
  2349. var
  2350.   Rect: TIvGridRect;
  2351. begin
  2352.   Rect.Top := ARow;
  2353.   Rect.Left := ACol;
  2354.   Rect.Bottom := ARow;
  2355.   Rect.Right := ACol;
  2356.   InvalidateRect(Rect);
  2357. end;
  2358.  
  2359. procedure TIvCustomGrid.InvalidateCol(ACol: Longint);
  2360. var
  2361.   Rect: TIvGridRect;
  2362. begin
  2363.   if not HandleAllocated then Exit;
  2364.   Rect.Top := 0;
  2365.   Rect.Left := ACol;
  2366.   Rect.Bottom := VisibleRowCount+1;
  2367.   Rect.Right := ACol;
  2368.   InvalidateRect(Rect);
  2369. end;
  2370.  
  2371. procedure TIvCustomGrid.InvalidateRow(ARow: Longint);
  2372. var
  2373.   Rect: TIvGridRect;
  2374. begin
  2375.   if not HandleAllocated then Exit;
  2376.   Rect.Top := ARow;
  2377.   Rect.Left := 0;
  2378.   Rect.Bottom := ARow;
  2379.   Rect.Right := VisibleColCount+1;
  2380.   InvalidateRect(Rect);
  2381. end;
  2382.  
  2383. procedure TIvCustomGrid.InvalidateGrid;
  2384. begin
  2385.   Invalidate;
  2386. end;
  2387.  
  2388. procedure TIvCustomGrid.InvalidateRect(ARect: TIvGridRect);
  2389. var
  2390.   InvalidRect: TRect;
  2391. begin
  2392.   if not HandleAllocated then Exit;
  2393.   GridRectToScreenRect(ARect, InvalidRect, True);
  2394.   Windows.InvalidateRect(Handle, @InvalidRect, False);
  2395. end;
  2396.  
  2397. procedure TIvCustomGrid.ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  2398. var
  2399.   NewTopLeft, MaxTopLeft: TIvGridCoord;
  2400.   DrawInfo: TIvGridDrawInfo;
  2401.  
  2402.   function Min: Longint;
  2403.   begin
  2404.     if ScrollBar = SB_HORZ then
  2405.       Result := FixedCols
  2406.     else
  2407.       Result := FixedRows;
  2408.   end;
  2409.  
  2410.   function Max: Longint;
  2411.   begin
  2412.     if ScrollBar = SB_HORZ then
  2413.       Result := MaxTopLeft.X
  2414.     else
  2415.       Result := MaxTopLeft.Y;
  2416.   end;
  2417.  
  2418.   function PageUp: Longint;
  2419.   var
  2420.     MaxTopLeft: TIvGridCoord;
  2421.   begin
  2422.     MaxTopLeft := CalcMaxTopLeft(FTopLeft, DrawInfo);
  2423.     if ScrollBar = SB_HORZ then
  2424.       Result := FTopLeft.X - MaxTopLeft.X else
  2425.       Result := FTopLeft.Y - MaxTopLeft.Y;
  2426.     if Result < 1 then Result := 1;
  2427.   end;
  2428.  
  2429.   function PageDown: Longint;
  2430.   var
  2431.     DrawInfo: TIvGridDrawInfo;
  2432.   begin
  2433.     CalcDrawInfo(DrawInfo);
  2434.     with DrawInfo do
  2435.       if ScrollBar = SB_HORZ then
  2436.         Result := Horz.LastFullVisibleCell - FTopLeft.X else
  2437.         Result := Vert.LastFullVisibleCell - FTopLeft.Y;
  2438.     if Result < 1 then Result := 1;
  2439.   end;
  2440.  
  2441.   function CalcVerticalScrollBar(Value: Longint): Longint;
  2442.   begin
  2443.     Result := Value;
  2444.     case ScrollCode of
  2445.       SB_LINEUP:
  2446.         Result := Value - 1;
  2447.  
  2448.       SB_LINEDOWN:
  2449.         Result := Value + 1;
  2450.  
  2451.       SB_PAGEUP:
  2452.         Result := Value - PageUp;
  2453.  
  2454.       SB_PAGEDOWN:
  2455.         Result := Value + PageDown;
  2456.  
  2457.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2458.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2459.           Result := Min + LongMulDiv(Pos, Max - Min, IvMaxShortInt);
  2460.  
  2461.       SB_BOTTOM:
  2462.         Result := Min;
  2463.  
  2464.       SB_TOP:
  2465.         Result := Min;
  2466.     end;
  2467.   end;
  2468.  
  2469.   function CalcHorizontalScrollBar(Value: Longint): Longint;
  2470.   begin
  2471.     Result := Value;
  2472.     case ScrollCode of
  2473.       SB_LINEUP:
  2474.           Result := Value - 1;
  2475.  
  2476.       SB_LINEDOWN:
  2477.           Result := Value + 1;
  2478.  
  2479.       SB_PAGEUP:
  2480.           Result := Value - PageUp;
  2481.  
  2482.       SB_PAGEDOWN:
  2483.           Result := Value + PageDown;
  2484.  
  2485.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2486.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2487.         begin
  2488.             Result := Min + LongMulDiv(Pos, Max - Min, IvMaxShortInt);
  2489.         end;
  2490.  
  2491.       SB_BOTTOM:
  2492.           Result := Min;
  2493.  
  2494.       SB_TOP:
  2495.           Result := Min;
  2496.     end;
  2497.   end;
  2498.  
  2499.   procedure ModifyPixelScrollBar(Code, Pos: Cardinal);
  2500.   var
  2501.     NewOffset: Integer;
  2502.     OldOffset: Integer;
  2503.     R: TIvGridRect;
  2504.     GridSpace, ColWidth: Integer;
  2505.   begin
  2506.     NewOffset := FColOffset;
  2507.     ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
  2508.     GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
  2509.     case Code of
  2510.       SB_LINEUP: Dec(NewOffset, Canvas.TextWidth('0'));
  2511.       SB_LINEDOWN: Inc(NewOffset, Canvas.TextWidth('0'));
  2512.       SB_PAGEUP: Dec(NewOffset, GridSpace);
  2513.       SB_PAGEDOWN: Inc(NewOffset, GridSpace);
  2514.       SB_THUMBPOSITION: NewOffset := Pos;
  2515.       SB_THUMBTRACK: if goThumbTracking in Options then NewOffset := Pos;
  2516.       SB_BOTTOM: NewOffset := 0;
  2517.       SB_TOP: NewOffset := ColWidth - GridSpace;
  2518.     end;
  2519.     if NewOffset < 0 then
  2520.       NewOffset := 0
  2521.     else if NewOffset >= ColWidth - GridSpace then
  2522.       NewOffset := ColWidth - GridSpace;
  2523.     if NewOffset <> FColOffset then
  2524.     begin
  2525.       OldOffset := FColOffset;
  2526.       FColOffset := NewOffset;
  2527.       ScrollData(OldOffset - NewOffset, 0);
  2528.       FillChar(R, SizeOf(R), 0);
  2529.       R.Bottom := FixedRows;
  2530.       InvalidateRect(R);
  2531.       Update;
  2532.       UpdateScrollPos;
  2533.     end;
  2534.   end;
  2535.  
  2536. begin
  2537.   if Visible and CanFocus and TabStop and not (csDesigning in ComponentState) then
  2538.     SetFocus;
  2539.   CalcDrawInfo(DrawInfo);
  2540.   if (ScrollBar = SB_HORZ) and (ColCount = 1) then
  2541.   begin
  2542.     ModifyPixelScrollBar(ScrollCode, Pos);
  2543.     Exit;
  2544.   end;
  2545.  
  2546.   MaxTopLeft.X := ColCount - 1;
  2547.   MaxTopLeft.Y := RowCount - 1;
  2548.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2549.   NewTopLeft := FTopLeft;
  2550.  
  2551.   if ScrollBar = SB_HORZ then
  2552.     NewTopLeft.X := CalcHorizontalScrollBar(NewTopLeft.X)
  2553.   else
  2554.     NewTopLeft.Y := CalcVerticalScrollBar(NewTopLeft.Y);
  2555.  
  2556.   if NewTopLeft.X < FixedCols then
  2557.     NewTopLeft.X := FixedCols
  2558.   else if NewTopLeft.X > MaxTopLeft.X then
  2559.     NewTopLeft.X := MaxTopLeft.X;
  2560.  
  2561.   if NewTopLeft.Y < FixedRows then
  2562.     NewTopLeft.Y := FixedRows
  2563.   else if NewTopLeft.Y > MaxTopLeft.Y then
  2564.     NewTopLeft.Y := MaxTopLeft.Y;
  2565.  
  2566.   if (NewTopLeft.X <> FTopLeft.X) or (NewTopLeft.Y <> FTopLeft.Y) then
  2567.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2568. end;
  2569.  
  2570. procedure TIvCustomGrid.MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  2571. var
  2572.   Min, Max: Longint;
  2573. begin
  2574.   if CellPos = FromIndex then CellPos := ToIndex
  2575.   else
  2576.   begin
  2577.     Min := FromIndex;
  2578.     Max := ToIndex;
  2579.     if FromIndex > ToIndex then
  2580.     begin
  2581.       Min := ToIndex;
  2582.       Max := FromIndex;
  2583.     end;
  2584.     if (CellPos >= Min) and (CellPos <= Max) then
  2585.       if FromIndex > ToIndex then
  2586.         Inc(CellPos) else
  2587.         Dec(CellPos);
  2588.   end;
  2589. end;
  2590.  
  2591. procedure TIvCustomGrid.MoveAnchor(const NewAnchor: TIvGridCoord);
  2592. var
  2593.   OldSel: TIvGridRect;
  2594. begin
  2595.   if [goRangeSelect, goEditing] * Options = [goRangeSelect] then
  2596.   begin
  2597.     OldSel := Selection;
  2598.     FAnchor := NewAnchor;
  2599.     if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2600.     ClampInView(NewAnchor);
  2601.     SelectionMoved(OldSel);
  2602.   end
  2603.   else
  2604.     MoveCurrent(NewAnchor.X, NewAnchor.Y, True, True);
  2605. end;
  2606.  
  2607. procedure TIvCustomGrid.MoveCurrent(
  2608.   aCol, aRow: Longint;
  2609.   moveAnchor, show: Boolean);
  2610. var
  2611.   oldSel: TIvGridRect;
  2612.   oldCurrent: TIvGridCoord;
  2613. begin
  2614.   if (aCol < 0) or (aRow < 0) or (aCol >= ColCount) or (aRow >= RowCount) then
  2615.     InvalidOp(SIndexOutOfRange);
  2616.  
  2617.   if SelectCell(aCol, aRow) then
  2618.   begin
  2619.     oldSel := Selection;
  2620.     oldCurrent := FCurrent;
  2621.     FCurrent.X := aCol;
  2622.     FCurrent.Y := aRow;
  2623.     if not (goAlwaysShowEditor in Options) then
  2624.       HideEditor;
  2625.     if MoveAnchor or not (goRangeSelect in Options) then
  2626.     begin
  2627.       FAnchor := FCurrent;
  2628.       if goRowSelect in Options then
  2629.         FAnchor.X := ColCount - 1;
  2630.     end;
  2631.     if goRowSelect in Options then
  2632.       FCurrent.X := FixedCols;
  2633.     if Show then
  2634.       ClampInView(FCurrent);
  2635.     SelectionMoved(OldSel);
  2636.     InvalidateCell(oldCurrent.X, oldCurrent.Y);
  2637.     InvalidateCell(aCol, aRow);
  2638.   end;
  2639. end;
  2640.  
  2641. procedure TIvCustomGrid.MoveTopLeft(ALeft, ATop: Longint);
  2642. var
  2643.   OldTopLeft: TIvGridCoord;
  2644. begin
  2645.   if (ALeft = FTopLeft.X) and (ATop = FTopLeft.Y) then Exit;
  2646.   Update;
  2647.   OldTopLeft := FTopLeft;
  2648.   FTopLeft.X := ALeft;
  2649.   FTopLeft.Y := ATop;
  2650.   TopLeftMoved(OldTopLeft);
  2651. end;
  2652.  
  2653. procedure TIvCustomGrid.ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  2654. begin
  2655.   InvalidateGrid;
  2656. end;
  2657.  
  2658. procedure TIvCustomGrid.ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  2659. begin
  2660.   InvalidateGrid;
  2661. end;
  2662.  
  2663. procedure TIvCustomGrid.SelectionMoved(const OldSel: TIvGridRect);
  2664. var
  2665.   OldRect, NewRect: TRect;
  2666.   AXorRects: TXorRects;
  2667.   I: Integer;
  2668. begin
  2669.   if not HandleAllocated then
  2670.     Exit;
  2671.  
  2672.   GridRectToScreenRect(OldSel, OldRect, True);
  2673.   GridRectToScreenRect(Selection, NewRect, True);
  2674.   XorRects(OldRect, NewRect, AXorRects);
  2675.   for I := Low(AXorRects) to High(AXorRects) do
  2676.     Windows.InvalidateRect(Handle, @AXorRects[I], False);
  2677. end;
  2678.  
  2679. procedure TIvCustomGrid.ScrollDataInfo(DX, DY: Integer;
  2680.   var DrawInfo: TIvGridDrawInfo);
  2681. var
  2682.   ScrollArea: TRect;
  2683.   ScrollFlags: Integer;
  2684. begin
  2685.   with DrawInfo do
  2686.   begin
  2687.     ScrollFlags := SW_INVALIDATE;
  2688.     if not DefaultDrawing then
  2689.       ScrollFlags := ScrollFlags or SW_ERASE;
  2690.     { Scroll the area }
  2691.     if DY = 0 then
  2692.     begin
  2693.       { Scroll both the column titles and data area at the same time }
  2694.       begin
  2695.         ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.GridExtent);
  2696.         ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2697.       end;
  2698.     end
  2699.     else if DX = 0 then
  2700.     begin
  2701.       { Scroll both the row titles and data area at the same time }
  2702.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.GridExtent, Vert.GridExtent);
  2703.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2704.     end
  2705.     else
  2706.     begin
  2707.       { Scroll titles and data area separately }
  2708.       { Column titles }
  2709.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.FixedBoundary);
  2710.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2711.       { Row titles }
  2712.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.FixedBoundary, Vert.GridExtent);
  2713.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2714.       { Data area }
  2715.       ScrollArea := Rect(Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridExtent,
  2716.         Vert.GridExtent);
  2717.       ScrollWindowEx(Handle, DX, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2718.     end;
  2719.   end;
  2720. end;
  2721.  
  2722. procedure TIvCustomGrid.ScrollData(DX, DY: Integer);
  2723. var
  2724.   DrawInfo: TIvGridDrawInfo;
  2725. begin
  2726.   CalcDrawInfo(DrawInfo);
  2727.   ScrollDataInfo(DX, DY, DrawInfo);
  2728. end;
  2729.  
  2730. procedure TIvCustomGrid.TopLeftMoved(const OldTopLeft: TIvGridCoord);
  2731.  
  2732.   function CalcScroll(const AxisInfo: TIvGridAxisDrawInfo;
  2733.     OldPos, CurrentPos: Integer; var Amount: Longint): Boolean;
  2734.   var
  2735.     Start, Stop: Longint;
  2736.     I: Longint;
  2737.   begin
  2738.     Result := False;
  2739.     with AxisInfo do
  2740.     begin
  2741.       if OldPos < CurrentPos then
  2742.       begin
  2743.         Start := OldPos;
  2744.         Stop := CurrentPos;
  2745.       end
  2746.       else
  2747.       begin
  2748.         Start := CurrentPos;
  2749.         Stop := OldPos;
  2750.       end;
  2751.       Amount := 0;
  2752.       for I := Start to Stop - 1 do
  2753.       begin
  2754.         Inc(Amount, GetExtent(I) + EffectiveLineWidth);
  2755.         if Amount > (GridBoundary - FixedBoundary) then
  2756.         begin
  2757.           { Scroll amount too big, redraw the whole thing }
  2758.           InvalidateGrid;
  2759.           Exit;
  2760.         end;
  2761.       end;
  2762.       if OldPos < CurrentPos then Amount := -Amount;
  2763.     end;
  2764.     Result := True;
  2765.   end;
  2766.  
  2767. var
  2768.   DrawInfo: TIvGridDrawInfo;
  2769.   Delta: TIvGridCoord;
  2770. begin
  2771.   UpdateScrollPos;
  2772.   CalcDrawInfo(DrawInfo);
  2773.   if CalcScroll(DrawInfo.Horz, OldTopLeft.X, FTopLeft.X, Delta.X) and
  2774.     CalcScroll(DrawInfo.Vert, OldTopLeft.Y, FTopLeft.Y, Delta.Y) then
  2775.     ScrollDataInfo(Delta.X, Delta.Y, DrawInfo);
  2776.   TopLeftChanged;
  2777. end;
  2778.  
  2779. procedure TIvCustomGrid.UpdateScrollPos;
  2780. var
  2781.   DrawInfo: TIvGridDrawInfo;
  2782.   MaxTopLeft: TIvGridCoord;
  2783.  
  2784.   procedure SetScroll(Code: Word; Value: Integer);
  2785.   begin
  2786.     if GetScrollPos(Handle, Code) <> Value then
  2787.       SetScrollPos(Handle, Code, Value, True);
  2788.   end;
  2789.  
  2790. var
  2791.   GridSpace, ColWidth: Integer;
  2792.  
  2793. begin
  2794.   if (not HandleAllocated) or (ScrollBars = ssNone) then Exit;
  2795.   CalcDrawInfo(DrawInfo);
  2796.   MaxTopLeft.X := ColCount - 1;
  2797.   MaxTopLeft.Y := RowCount - 1;
  2798.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2799.   if ScrollBars in [ssHorizontal, ssBoth] then
  2800.     if ColCount = 1 then
  2801.     begin
  2802.       ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
  2803.       GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
  2804.       if (FColOffset > 0) and (GridSpace > (ColWidth - FColOffset)) then
  2805.         ModifyScrollbar(SB_HORZ, SB_THUMBPOSITION, ColWidth - GridSpace)
  2806.       else
  2807.         SetScroll(SB_HORZ, FColOffset)
  2808.     end
  2809.     else
  2810.     begin
  2811.         SetScroll(
  2812.           SB_HORZ,
  2813.           LongMulDiv(FTopLeft.X - FixedCols, IvMaxShortInt, MaxTopLeft.X - FixedCols));
  2814.     end;
  2815.   if ScrollBars in [ssVertical, ssBoth] then
  2816.     SetScroll(SB_VERT, LongMulDiv(FTopLeft.Y - FixedRows, IvMaxShortInt,
  2817.       MaxTopLeft.Y - FixedRows));
  2818. end;
  2819.  
  2820. procedure TIvCustomGrid.UpdateScrollRange;
  2821. var
  2822.   MaxTopLeft, OldTopLeft: TIvGridCoord;
  2823.   DrawInfo: TIvGridDrawInfo;
  2824.   OldScrollBars: TScrollStyle;
  2825.   Updated: Boolean;
  2826.  
  2827.   procedure DoUpdate;
  2828.   begin
  2829.     if not Updated then
  2830.     begin
  2831.       Update;
  2832.       Updated := True;
  2833.     end;
  2834.   end;
  2835.  
  2836.   function ScrollBarVisible(Code: Word): Boolean;
  2837.   var
  2838.     Min, Max: Integer;
  2839.   begin
  2840.     Result := False;
  2841.     if (ScrollBars = ssBoth) or
  2842.       ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
  2843.       ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
  2844.     begin
  2845.       GetScrollRange(Handle, Code, Min, Max);
  2846.       Result := Min <> Max;
  2847.     end;
  2848.   end;
  2849.  
  2850.   procedure CalcSizeInfo;
  2851.   begin
  2852.     CalcDrawInfoXY(DrawInfo, DrawInfo.Horz.GridExtent, DrawInfo.Vert.GridExtent);
  2853.     MaxTopLeft.X := ColCount - 1;
  2854.     MaxTopLeft.Y := RowCount - 1;
  2855.     MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2856.   end;
  2857.  
  2858.   procedure SetAxisRange(var Max, Old, Current: Longint; Code: Word;
  2859.     Fixeds: Integer);
  2860.   begin
  2861.     CalcSizeInfo;
  2862.     if Fixeds < Max then
  2863.       SetScrollRange(Handle, Code, 0, IvMaxShortInt, True)
  2864.     else
  2865.       SetScrollRange(Handle, Code, 0, 0, True);
  2866.     if Old > Max then
  2867.     begin
  2868.       DoUpdate;
  2869.       Current := Max;
  2870.     end;
  2871.   end;
  2872.  
  2873.   procedure SetHorzRange;
  2874.   var
  2875.     Range: Integer;
  2876.   begin
  2877.     if OldScrollBars in [ssHorizontal, ssBoth] then
  2878.       if ColCount = 1 then
  2879.       begin
  2880.         Range := ColWidths[0] - ClientWidth;
  2881.         if Range < 0 then Range := 0;
  2882.         SetScrollRange(Handle, SB_HORZ, 0, Range, True);
  2883.       end
  2884.       else
  2885.         SetAxisRange(MaxTopLeft.X, OldTopLeft.X, FTopLeft.X, SB_HORZ, FixedCols);
  2886.   end;
  2887.  
  2888.   procedure SetVertRange;
  2889.   begin
  2890.     if OldScrollBars in [ssVertical, ssBoth] then
  2891.       SetAxisRange(MaxTopLeft.Y, OldTopLeft.Y, FTopLeft.Y, SB_VERT, FixedRows);
  2892.   end;
  2893.  
  2894. begin
  2895.   if (ScrollBars = ssNone) or not HandleAllocated then Exit;
  2896.   with DrawInfo do
  2897.   begin
  2898.     Horz.GridExtent := ClientWidth;
  2899.     Vert.GridExtent := ClientHeight;
  2900.     { Ignore scroll bars for initial calculation }
  2901.     if ScrollBarVisible(SB_HORZ) then
  2902.       Inc(Vert.GridExtent, GetSystemMetrics(SM_CYHSCROLL));
  2903.     if ScrollBarVisible(SB_VERT) then
  2904.       Inc(Horz.GridExtent, GetSystemMetrics(SM_CXVSCROLL));
  2905.   end;
  2906.   OldTopLeft := FTopLeft;
  2907.   { Temporarily mark us as not having scroll bars to avoid recursion }
  2908.   OldScrollBars := FScrollBars;
  2909.   FScrollBars := ssNone;
  2910.   Updated := False;
  2911.   try
  2912.     { Update scrollbars }
  2913.     SetHorzRange;
  2914.     DrawInfo.Vert.GridExtent := ClientHeight;
  2915.     SetVertRange;
  2916.     if DrawInfo.Horz.GridExtent <> ClientWidth then
  2917.     begin
  2918.       DrawInfo.Horz.GridExtent := ClientWidth;
  2919.       SetHorzRange;
  2920.     end;
  2921.   finally
  2922.     FScrollBars := OldScrollBars;
  2923.   end;
  2924.   UpdateScrollPos;
  2925.   if (FTopLeft.X <> OldTopLeft.X) or (FTopLeft.Y <> OldTopLeft.Y) then
  2926.     TopLeftMoved(OldTopLeft);
  2927. end;
  2928.  
  2929. function TIvCustomGrid.CreateEditor: TIvInplaceEdit;
  2930. begin
  2931.   Result := TIvInplaceEdit.Create(Self);
  2932. end;
  2933.  
  2934. procedure TIvCustomGrid.CreateParams(var Params: TCreateParams);
  2935. begin
  2936.   inherited CreateParams(Params);
  2937.   with Params do
  2938.   begin
  2939.     Style := Style or WS_TABSTOP;
  2940.     if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
  2941.     if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
  2942.     WindowClass.style := CS_DBLCLKS;
  2943.     if FBorderStyle = bsSingle then
  2944.       if NewStyleControls and Ctl3D then
  2945.       begin
  2946.         Style := Style and not WS_BORDER;
  2947.         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  2948.       end
  2949.       else
  2950.         Style := Style or WS_BORDER;
  2951.   end;
  2952. end;
  2953.  
  2954. procedure TIvCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2955. var
  2956.   NewTopLeft, NewCurrent, MaxTopLeft: TIvGridCoord;
  2957.   DrawInfo: TIvGridDrawInfo;
  2958.   PageWidth, PageHeight: Integer;
  2959.  
  2960.   procedure CalcPageExtents;
  2961.   begin
  2962.     CalcDrawInfo(DrawInfo);
  2963.     PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
  2964.     if PageWidth < 1 then PageWidth := 1;
  2965.     PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
  2966.     if PageHeight < 1 then PageHeight := 1;
  2967.   end;
  2968.  
  2969.   procedure Restrict(var Coord: TIvGridCoord; MinX, MinY, MaxX, MaxY: Longint);
  2970.   begin
  2971.     with Coord do
  2972.     begin
  2973.       if X > MaxX then X := MaxX
  2974.       else if X < MinX then X := MinX;
  2975.       if Y > MaxY then Y := MaxY
  2976.       else if Y < MinY then Y := MinY;
  2977.     end;
  2978.   end;
  2979.  
  2980. begin
  2981.   inherited KeyDown(Key, Shift);
  2982.   if not CanGridAcceptKey(Key, Shift) then Key := 0;
  2983.   NewCurrent := FCurrent;
  2984.   NewTopLeft := FTopLeft;
  2985.   CalcPageExtents;
  2986.   if ssCtrl in Shift then
  2987.     case Key of
  2988.       VK_UP: Dec(NewTopLeft.Y);
  2989.       VK_DOWN: Inc(NewTopLeft.Y);
  2990.       VK_LEFT:
  2991.         if not (goRowSelect in Options) then
  2992.         begin
  2993.           Dec(NewCurrent.X, PageWidth);
  2994.           Dec(NewTopLeft.X, PageWidth);
  2995.         end;
  2996.       VK_RIGHT:
  2997.         if not (goRowSelect in Options) then
  2998.         begin
  2999.           Inc(NewCurrent.X, PageWidth);
  3000.           Inc(NewTopLeft.X, PageWidth);
  3001.         end;
  3002.       VK_PRIOR: NewCurrent.Y := TopRow;
  3003.       VK_NEXT: NewCurrent.Y := DrawInfo.Vert.LastFullVisibleCell;
  3004.       VK_HOME:
  3005.         begin
  3006.           NewCurrent.X := FixedCols;
  3007.           NewCurrent.Y := FixedRows;
  3008.         end;
  3009.       VK_END:
  3010.         begin
  3011.           NewCurrent.X := ColCount - 1;
  3012.           NewCurrent.Y := RowCount - 1;
  3013.         end;
  3014.     end
  3015.   else
  3016.     case Key of
  3017.       VK_UP: Dec(NewCurrent.Y);
  3018.       VK_DOWN: Inc(NewCurrent.Y);
  3019.       VK_LEFT:
  3020.         if goRowSelect in Options then
  3021.           Dec(NewCurrent.Y) else
  3022.           Dec(NewCurrent.X);
  3023.       VK_RIGHT:
  3024.         if goRowSelect in Options then
  3025.           Inc(NewCurrent.Y) else
  3026.           Inc(NewCurrent.X);
  3027.       VK_NEXT:
  3028.         begin
  3029.           Inc(NewCurrent.Y, PageHeight);
  3030.           Inc(NewTopLeft.Y, PageHeight);
  3031.         end;
  3032.       VK_PRIOR:
  3033.         begin
  3034.           Dec(NewCurrent.Y, PageHeight);
  3035.           Dec(NewTopLeft.Y, PageHeight);
  3036.         end;
  3037.       VK_HOME:
  3038.         if goRowSelect in Options then
  3039.           NewCurrent.Y := FixedRows else
  3040.           NewCurrent.X := FixedCols;
  3041.       VK_END:
  3042.         if goRowSelect in Options then
  3043.           NewCurrent.Y := RowCount - 1 else
  3044.           NewCurrent.X := ColCount - 1;
  3045.       VK_TAB:
  3046.         if not (ssAlt in Shift) then
  3047.         repeat
  3048.           if ssShift in Shift then
  3049.           begin
  3050.             Dec(NewCurrent.X);
  3051.             if NewCurrent.X < FixedCols then
  3052.             begin
  3053.               NewCurrent.X := ColCount - 1;
  3054.               Dec(NewCurrent.Y);
  3055.               if NewCurrent.Y < FixedRows then NewCurrent.Y := RowCount - 1;
  3056.             end;
  3057.             Shift := [];
  3058.           end
  3059.           else
  3060.           begin
  3061.             Inc(NewCurrent.X);
  3062.             if NewCurrent.X >= ColCount then
  3063.             begin
  3064.               NewCurrent.X := FixedCols;
  3065.               Inc(NewCurrent.Y);
  3066.               if NewCurrent.Y >= RowCount then NewCurrent.Y := FixedRows;
  3067.             end;
  3068.           end;
  3069.         until TabStops[NewCurrent.X] or (NewCurrent.X = FCurrent.X);
  3070.       VK_F2: EditorMode := True;
  3071.     end;
  3072.   MaxTopLeft.X := ColCount - 1;
  3073.   MaxTopLeft.Y := RowCount - 1;
  3074.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  3075.   Restrict(NewTopLeft, FixedCols, FixedRows, MaxTopLeft.X, MaxTopLeft.Y);
  3076.   if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
  3077.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  3078.   Restrict(NewCurrent, FixedCols, FixedRows, ColCount - 1, RowCount - 1);
  3079.   if (NewCurrent.X <> Col) or (NewCurrent.Y <> Row) then
  3080.     FocusCell(NewCurrent.X, NewCurrent.Y, not (ssShift in Shift));
  3081. end;
  3082.  
  3083. procedure TIvCustomGrid.KeyPress(var Key: Char);
  3084. begin
  3085.   inherited KeyPress(Key);
  3086.   if not (goAlwaysShowEditor in Options) and (Key = #13) then
  3087.   begin
  3088.     if FEditorMode then
  3089.       HideEditor else
  3090.       ShowEditor;
  3091.     Key := #0;
  3092.   end;
  3093. end;
  3094.  
  3095. procedure TIvCustomGrid.MouseDown(
  3096.   button: TMouseButton;
  3097.   shift: TShiftState;
  3098.   x, y: Integer);
  3099. var
  3100.   CellHit: TIvGridCoord;
  3101.   DrawInfo: TIvGridDrawInfo;
  3102.   MoveDrawn: Boolean;
  3103. begin
  3104.   MoveDrawn := False;
  3105.   HideEdit;
  3106.   if not (csDesigning in ComponentState) and
  3107.     (CanFocus or (GetParentForm(Self) = nil)) then
  3108.   begin
  3109.     SetFocus;
  3110.     if not IsActiveControl then
  3111.     begin
  3112.       MouseCapture := False;
  3113.       Exit;
  3114.     end;
  3115.   end;
  3116.   if (Button = mbLeft) and (ssDouble in Shift) then
  3117.     DblClick
  3118.   else if Button = mbLeft then
  3119.   begin
  3120.     CalcDrawInfo(DrawInfo);
  3121.     { Check grid sizing }
  3122.     CalcSizingState(X, Y, FGridState, FSizingIndex, FSizingPos, FSizingOfs,
  3123.       DrawInfo);
  3124.     if FGridState <> gsNormal then
  3125.     begin
  3126.       DrawSizingLine(DrawInfo);
  3127.       Exit;
  3128.     end;
  3129.     CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3130.     if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) then
  3131.     begin
  3132.       if goEditing in Options then
  3133.       begin
  3134.         if (CellHit.X = FCurrent.X) and (CellHit.Y = FCurrent.Y) then
  3135.           ShowEditor
  3136.         else
  3137.         begin
  3138.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  3139.           UpdateEdit;
  3140.         end;
  3141.         Click;
  3142.       end
  3143.       else
  3144.       begin
  3145.         FGridState := gsSelecting;
  3146.         SetTimer(Handle, 1, 60, nil);
  3147.         if ssShift in Shift then
  3148.           MoveAnchor(CellHit)
  3149.         else
  3150.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  3151.       end;
  3152.     end
  3153.     else if (goRowMoving in Options) and (CellHit.X >= 0) and
  3154.       (CellHit.X < FixedCols) and (CellHit.Y >= FixedRows) then
  3155.     begin
  3156.       FGridState := gsRowMoving;
  3157.       FMoveIndex := CellHit.Y;
  3158.       FMovePos := FMoveIndex;
  3159.       Update;
  3160.       DrawMove;
  3161.       MoveDrawn := True;
  3162.       SetTimer(Handle, 1, 60, nil);
  3163.     end
  3164.     else if (goColMoving in Options) and (CellHit.Y >= 0) and
  3165.       (CellHit.Y < FixedRows) and (CellHit.X >= FixedCols) then
  3166.     begin
  3167.       FGridState := gsColMoving;
  3168.       FMoveIndex := CellHit.X;
  3169.       FMovePos := FMoveIndex;
  3170.       Update;
  3171.       DrawMove;
  3172.       MoveDrawn := True;
  3173.       SetTimer(Handle, 1, 60, nil);
  3174.     end;
  3175.   end;
  3176.   try
  3177.     inherited MouseDown(Button, Shift, X, Y);
  3178.   except
  3179.     if MoveDrawn then DrawMove;
  3180.   end;
  3181. end;
  3182.  
  3183. procedure TIvCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  3184. var
  3185.   DrawInfo: TIvGridDrawInfo;
  3186.   CellHit: TIvGridCoord;
  3187. begin
  3188.   CalcDrawInfo(DrawInfo);
  3189.   case FGridState of
  3190.     gsSelecting, gsColMoving, gsRowMoving:
  3191.       begin
  3192.         CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3193.         if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) and
  3194.           (CellHit.X <= DrawInfo.Horz.LastFullVisibleCell+1) and
  3195.           (CellHit.Y <= DrawInfo.Vert.LastFullVisibleCell+1) then
  3196.           case FGridState of
  3197.             gsSelecting:
  3198.               if ((CellHit.X <> FAnchor.X) or (CellHit.Y <> FAnchor.Y)) then
  3199.                 MoveAnchor(CellHit);
  3200.             gsColMoving:
  3201.               MoveAndScroll(X, CellHit.X, DrawInfo, DrawInfo.Horz, SB_HORZ);
  3202.             gsRowMoving:
  3203.               MoveAndScroll(Y, CellHit.Y, DrawInfo, DrawInfo.Vert, SB_VERT);
  3204.           end;
  3205.       end;
  3206.     gsRowSizing, gsColSizing:
  3207.       begin
  3208.         DrawSizingLine(DrawInfo); { XOR it out }
  3209.         if FGridState = gsRowSizing then
  3210.           FSizingPos := Y + FSizingOfs else
  3211.           FSizingPos := X + FSizingOfs;
  3212.         DrawSizingLine(DrawInfo); { XOR it back in }
  3213.       end;
  3214.   end;
  3215.   inherited MouseMove(Shift, X, Y);
  3216. end;
  3217.  
  3218. procedure TIvCustomGrid.MouseUp(
  3219.   button: TMouseButton;
  3220.   shift: TShiftState;
  3221.   x, y: Integer);
  3222. var
  3223.   drawInfo: TIvGridDrawInfo;
  3224.   newSize: Integer;
  3225.  
  3226.   function ResizeLine(const axisInfo: TIvGridAxisDrawInfo): Integer;
  3227.   var
  3228.     i: Integer;
  3229.   begin
  3230.     Result := axisInfo.FixedBoundary;
  3231.     for i := axisInfo.FirstGridCell to FSizingIndex - 1 do
  3232.       Inc(Result, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  3233.       Result := FSizingPos - Result;
  3234.   end;
  3235.  
  3236. begin
  3237.   try
  3238.     case FGridState of
  3239.       gsSelecting:
  3240.         begin
  3241.           MouseMove(Shift, X, Y);
  3242.           KillTimer(Handle, 1);
  3243.           UpdateEdit;
  3244.           Click;
  3245.         end;
  3246.  
  3247.       gsRowSizing, gsColSizing:
  3248.         begin
  3249.           CalcDrawInfo(drawInfo);
  3250.           DrawSizingLine(drawInfo);
  3251.           if FGridState = gsColSizing then
  3252.           begin
  3253.             newSize := ResizeLine(drawInfo.Horz);
  3254.             if newSize > 1 then
  3255.             begin
  3256.               ColWidths[FSizingIndex] := newSize;
  3257.               UpdateDesigner;
  3258.             end;
  3259.           end
  3260.           else
  3261.           begin
  3262.             newSize := ResizeLine(drawInfo.Vert);
  3263.             if newSize > 1 then
  3264.             begin
  3265.               RowHeights[FSizingIndex] := newSize;
  3266.               UpdateDesigner;
  3267.             end;
  3268.           end;
  3269.         end;
  3270.  
  3271.       gsColMoving, gsRowMoving:
  3272.         begin
  3273.           DrawMove;
  3274.           KillTimer(Handle, 1);
  3275.           if FMoveIndex <> FMovePos then
  3276.           begin
  3277.             if FGridState = gsColMoving then
  3278.               MoveColumn(FMoveIndex, FMovePos)
  3279.             else
  3280.               MoveRow(FMoveIndex, FMovePos);
  3281.             UpdateDesigner;
  3282.           end;
  3283.           UpdateEdit;
  3284.         end;
  3285.     else
  3286.       UpdateEdit;
  3287.     end;
  3288.     inherited MouseUp(Button, Shift, X, Y);
  3289.   finally
  3290.     FGridState := gsNormal;
  3291.   end;
  3292. end;
  3293.  
  3294. procedure TIvCustomGrid.MoveAndScroll(Mouse, CellHit: Integer;
  3295.   var DrawInfo: TIvGridDrawInfo; var Axis: TIvGridAxisDrawInfo; ScrollBar: Integer);
  3296. begin
  3297.   if (CellHit <> FMovePos) and
  3298.     not((FMovePos = Axis.FixedCellCount) and (Mouse < Axis.FixedBoundary)) and
  3299.     not((FMovePos = Axis.GridCellCount-1) and (Mouse > Axis.GridBoundary)) then
  3300.   begin
  3301.     DrawMove;
  3302.     if (Mouse < Axis.FixedBoundary) then
  3303.     begin
  3304.       if (FMovePos > Axis.FixedCellCount) then
  3305.       begin
  3306.         ModifyScrollbar(ScrollBar, SB_LINEUP, 0);
  3307.         Update;
  3308.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3309.       end;
  3310.       CellHit := Axis.FirstGridCell;
  3311.     end
  3312.     else if (Mouse >= Axis.FullVisBoundary) then
  3313.     begin
  3314.       if (FMovePos = Axis.LastFullVisibleCell) and
  3315.         (FMovePos < Axis.GridCellCount -1) then
  3316.       begin
  3317.         ModifyScrollBar(Scrollbar, SB_LINEDOWN, 0);
  3318.         Update;
  3319.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3320.       end;
  3321.       CellHit := Axis.LastFullVisibleCell;
  3322.     end
  3323.     else if CellHit < 0 then CellHit := FMovePos;
  3324.     FMovePos := CellHit;
  3325.     DrawMove;
  3326.   end;
  3327. end;
  3328.  
  3329. function TIvCustomGrid.GetColWidths(Index: Longint): Integer;
  3330. begin
  3331.   if (FColWidths = nil) or (Index >= ColCount) then
  3332.     Result := DefaultColWidth
  3333.   else
  3334.     Result := PIntArray(FColWidths)^[Index + 1];
  3335. end;
  3336.  
  3337. function TIvCustomGrid.GetRowHeights(Index: Longint): Integer;
  3338. begin
  3339.   if (FRowHeights = nil) or (Index >= RowCount) then
  3340.     Result := DefaultRowHeight
  3341.   else
  3342.     Result := PIntArray(FRowHeights)^[Index + 1];
  3343. end;
  3344.  
  3345. function TIvCustomGrid.GetGridWidth: Integer;
  3346. var
  3347.   DrawInfo: TIvGridDrawInfo;
  3348. begin
  3349.   CalcDrawInfo(DrawInfo);
  3350.   Result := DrawInfo.Horz.GridBoundary;
  3351. end;
  3352.  
  3353. function TIvCustomGrid.GetGridHeight: Integer;
  3354. var
  3355.   DrawInfo: TIvGridDrawInfo;
  3356. begin
  3357.   CalcDrawInfo(DrawInfo);
  3358.   Result := DrawInfo.Vert.GridBoundary;
  3359. end;
  3360.  
  3361. function TIvCustomGrid.GetSelection: TIvGridRect;
  3362. begin
  3363.   Result := GridRect(FCurrent, FAnchor);
  3364. end;
  3365.  
  3366. function TIvCustomGrid.GetTabStops(Index: Longint): Boolean;
  3367. begin
  3368.   if FTabStops = nil then Result := True
  3369.   else Result := Boolean(PIntArray(FTabStops)^[Index + 1]);
  3370. end;
  3371.  
  3372. function TIvCustomGrid.GetVisibleColCount: Integer;
  3373. var
  3374.   DrawInfo: TIvGridDrawInfo;
  3375. begin
  3376.   CalcDrawInfo(DrawInfo);
  3377.   Result := DrawInfo.Horz.LastFullVisibleCell - LeftCol + 1;
  3378. end;
  3379.  
  3380. function TIvCustomGrid.GetVisibleRowCount: Integer;
  3381. var
  3382.   DrawInfo: TIvGridDrawInfo;
  3383. begin
  3384.   CalcDrawInfo(DrawInfo);
  3385.   Result := DrawInfo.Vert.LastFullVisibleCell - TopRow + 1;
  3386. end;
  3387.  
  3388. procedure TIvCustomGrid.SetBorderStyle(Value: TBorderStyle);
  3389. begin
  3390.   if FBorderStyle <> Value then
  3391.   begin
  3392.     FBorderStyle := Value;
  3393.     RecreateWnd;
  3394.   end;
  3395. end;
  3396.  
  3397. procedure TIvCustomGrid.SetCol(Value: Longint);
  3398. begin
  3399.   if Col <> Value then FocusCell(Value, Row, True);
  3400. end;
  3401.  
  3402. procedure TIvCustomGrid.SetColCount(Value: Longint);
  3403. begin
  3404.   if FColCount <> Value then
  3405.   begin
  3406.     if Value < 1 then
  3407.       Value := 1;
  3408.     if Value <= FixedCols then
  3409.       FixedCols := Value - 1;
  3410.     ChangeSize(Value, RowCount);
  3411.     if goRowSelect in Options then
  3412.     begin
  3413.       FAnchor.X := ColCount - 1;
  3414.       Invalidate;
  3415.     end;
  3416.   end;
  3417. end;
  3418.  
  3419. procedure TIvCustomGrid.SetColWidths(Index: Longint; Value: Integer);
  3420. begin
  3421.   if FColWidths = nil then
  3422.     UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  3423.  
  3424.   if Index >= ColCount then
  3425.     InvalidOp(SIndexOutOfRange);
  3426.  
  3427.   if Value <> PIntArray(FColWidths)^[Index + 1] then
  3428.   begin
  3429.     ResizeCol(Index, PIntArray(FColWidths)^[Index + 1], Value);
  3430.     PIntArray(FColWidths)^[Index + 1] := Value;
  3431.     ColWidthsChanged;
  3432.   end;
  3433. end;
  3434.  
  3435. procedure TIvCustomGrid.SetDefaultColWidth(Value: Integer);
  3436. begin
  3437.   if FColWidths <> nil then UpdateExtents(FColWidths, 0, 0);
  3438.   FDefaultColWidth := Value;
  3439.   ColWidthsChanged;
  3440.   InvalidateGrid;
  3441. end;
  3442.  
  3443. procedure TIvCustomGrid.SetDefaultRowHeight(Value: Integer);
  3444. begin
  3445.   if FRowHeights <> nil then UpdateExtents(FRowHeights, 0, 0);
  3446.   FDefaultRowHeight := Value;
  3447.   RowHeightsChanged;
  3448.   InvalidateGrid;
  3449. end;
  3450.  
  3451. procedure TIvCustomGrid.SetFixedColor(Value: TColor);
  3452. begin
  3453.   if FFixedColor <> Value then
  3454.   begin
  3455.     FFixedColor := Value;
  3456.     InvalidateGrid;
  3457.   end;
  3458. end;
  3459.  
  3460. procedure TIvCustomGrid.SetFixedCols(Value: Integer);
  3461. begin
  3462.   if FFixedCols <> Value then
  3463.   begin
  3464.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3465.     if Value >= ColCount then InvalidOp(SFixedColTooBig);
  3466.     FFixedCols := Value;
  3467.     Initialize;
  3468.     InvalidateGrid;
  3469.   end;
  3470. end;
  3471.  
  3472. procedure TIvCustomGrid.SetFixedRows(Value: Integer);
  3473. begin
  3474.   if FFixedRows <> Value then
  3475.   begin
  3476.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3477.     if Value >= RowCount then InvalidOp(SFixedRowTooBig);
  3478.     FFixedRows := Value;
  3479.     Initialize;
  3480.     InvalidateGrid;
  3481.   end;
  3482. end;
  3483.  
  3484. procedure TIvCustomGrid.SetEditorMode(Value: Boolean);
  3485. begin
  3486.   if not Value then
  3487.     HideEditor
  3488.   else
  3489.   begin
  3490.     ShowEditor;
  3491.     if FInplaceEdit <> nil then FInplaceEdit.Deselect;
  3492.   end;
  3493. end;
  3494.  
  3495. procedure TIvCustomGrid.SetGridLineWidth(Value: Integer);
  3496. begin
  3497.   if FGridLineWidth <> Value then
  3498.   begin
  3499.     FGridLineWidth := Value;
  3500.     InvalidateGrid;
  3501.   end;
  3502. end;
  3503.  
  3504. procedure TIvCustomGrid.SetLeftCol(Value: Longint);
  3505. begin
  3506.   if FTopLeft.X <> Value then MoveTopLeft(Value, TopRow);
  3507. end;
  3508.  
  3509. procedure TIvCustomGrid.SetOptions(Value: TIvGridOptions);
  3510. begin
  3511.   if FOptions <> Value then
  3512.   begin
  3513.     if goRowSelect in Value then
  3514.       Exclude(Value, goAlwaysShowEditor);
  3515.     FOptions := Value;
  3516.     if not FEditorMode then
  3517.       if goAlwaysShowEditor in Value then
  3518.         ShowEditor else
  3519.         HideEditor;
  3520.     if goRowSelect in Value then MoveCurrent(Col, Row,  True, False);
  3521.     InvalidateGrid;
  3522.   end;
  3523. end;
  3524.  
  3525. procedure TIvCustomGrid.SetRow(Value: Longint);
  3526. begin
  3527.   if Row <> Value then FocusCell(Col, Value, True);
  3528. end;
  3529.  
  3530. procedure TIvCustomGrid.SetRowCount(Value: Longint);
  3531. begin
  3532.   if FRowCount <> Value then
  3533.   begin
  3534.     if Value < 1 then Value := 1;
  3535.     if Value <= FixedRows then FixedRows := Value - 1;
  3536.     ChangeSize(ColCount, Value);
  3537.   end;
  3538. end;
  3539.  
  3540. procedure TIvCustomGrid.SetRowHeights(Index: Longint; Value: Integer);
  3541. begin
  3542.   if FRowHeights = nil then
  3543.     UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  3544.   if Index >= RowCount then InvalidOp(SIndexOutOfRange);
  3545.   if Value <> PIntArray(FRowHeights)^[Index + 1] then
  3546.   begin
  3547.     ResizeRow(Index, PIntArray(FRowHeights)^[Index + 1], Value);
  3548.     PIntArray(FRowHeights)^[Index + 1] := Value;
  3549.     RowHeightsChanged;
  3550.   end;
  3551. end;
  3552.  
  3553. procedure TIvCustomGrid.SetScrollBars(Value: TScrollStyle);
  3554. begin
  3555.   if FScrollBars <> Value then
  3556.   begin
  3557.     FScrollBars := Value;
  3558.     RecreateWnd;
  3559.   end;
  3560. end;
  3561.  
  3562. procedure TIvCustomGrid.SetSelection(Value: TIvGridRect);
  3563. var
  3564.   OldSel: TIvGridRect;
  3565. begin
  3566.   OldSel := Selection;
  3567.   FAnchor := Value.TopLeft;
  3568.   FCurrent := Value.BottomRight;
  3569.   SelectionMoved(OldSel);
  3570. end;
  3571.  
  3572. procedure TIvCustomGrid.SetTabStops(Index: Longint; Value: Boolean);
  3573. begin
  3574.   if FTabStops = nil then
  3575.     UpdateExtents(FTabStops, ColCount, Integer(True));
  3576.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3577.   PIntArray(FTabStops)^[Index + 1] := Integer(Value);
  3578. end;
  3579.  
  3580. procedure TIvCustomGrid.SetTopRow(Value: Longint);
  3581. begin
  3582.   if FTopLeft.Y <> Value then MoveTopLeft(LeftCol, Value);
  3583. end;
  3584.  
  3585. procedure TIvCustomGrid.HideEdit;
  3586. begin
  3587.   if FInplaceEdit <> nil then
  3588.     try
  3589.       UpdateText;
  3590.     finally
  3591.       FInplaceCol := -1;
  3592.       FInplaceRow := -1;
  3593.       FInplaceEdit.Hide;
  3594.     end;
  3595. end;
  3596.  
  3597. procedure TIvCustomGrid.UpdateEdit;
  3598.  
  3599.   procedure UpdateEditor;
  3600.   begin
  3601.     FInplaceCol := Col;
  3602.     FInplaceRow := Row;
  3603.     FInplaceEdit.UpdateContents;
  3604.     if FInplaceEdit.MaxLength = -1 then
  3605.       FCanEditModify := False
  3606.     else
  3607.       FCanEditModify := True;
  3608.     FInplaceEdit.SelectAll;
  3609.   end;
  3610.  
  3611. begin
  3612.   if CanEditShow then
  3613.   begin
  3614.     if FInplaceEdit = nil then
  3615.     begin
  3616. {      FInplaceEdit := CreateEditor;
  3617.       FInplaceEdit.SetGrid(Self);
  3618.       FInplaceEdit.Parent := Self;
  3619.       UpdateEditor;}
  3620.     end
  3621.     else
  3622.     begin
  3623.       if (Col <> FInplaceCol) or (Row <> FInplaceRow) then
  3624.       begin
  3625.         HideEdit;
  3626.         UpdateEditor;
  3627.       end;
  3628.     end;
  3629.  
  3630.     FInplaceEdit.Free;
  3631.     FInplaceEdit := CreateEditor;
  3632.     FInplaceEdit.SetGrid(Self);
  3633.     FInplaceEdit.Parent := Self;
  3634.     UpdateEditor;
  3635.  
  3636.     FInplaceEdit.UpdateBidi(IvIsLocaleBidirectional(ColLocale[Col]));
  3637.  
  3638.     if CanEditShow then
  3639.       FInplaceEdit.Move(CellRect(Col, Row));
  3640.   end;
  3641. end;
  3642.  
  3643. procedure TIvCustomGrid.UpdateText;
  3644. begin
  3645.   if (FInplaceCol <> -1) and (FInplaceRow <> -1) then
  3646.     SetEditText(FInplaceCol, FInplaceRow, FInplaceEdit.Text);
  3647. end;
  3648.  
  3649. procedure TIvCustomGrid.WMChar(var Msg: TWMChar);
  3650. begin
  3651.   if (goEditing in Options) and (Char(Msg.CharCode) in [^H, #32..#255]) then
  3652.     ShowEditorChar(Char(Msg.CharCode))
  3653.   else
  3654.     inherited;
  3655. end;
  3656.  
  3657. procedure TIvCustomGrid.WMCommand(var Message: TWMCommand);
  3658. begin
  3659.   with Message do
  3660.   begin
  3661.     if (FInplaceEdit <> nil) and (Ctl = FInplaceEdit.Handle) then
  3662.       case NotifyCode of
  3663.         EN_CHANGE: UpdateText;
  3664.       end;
  3665.   end;
  3666. end;
  3667.  
  3668. procedure TIvCustomGrid.WMGetDlgCode(var Msg: TWMGetDlgCode);
  3669. begin
  3670.   Msg.Result := DLGC_WANTARROWS;
  3671.   if goRowSelect in Options then Exit;
  3672.   if goTabs in Options then Msg.Result := Msg.Result or DLGC_WANTTAB;
  3673.   if goEditing in Options then Msg.Result := Msg.Result or DLGC_WANTCHARS;
  3674. end;
  3675.  
  3676. procedure TIvCustomGrid.WMKillFocus(var Msg: TWMKillFocus);
  3677. begin
  3678.   inherited;
  3679.   InvalidateRect(Selection);
  3680.   if (FInplaceEdit <> nil) and (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3681.     HideEdit;
  3682. end;
  3683.  
  3684. procedure TIvCustomGrid.WMLButtonDown(var Message: TMessage);
  3685. begin
  3686.   inherited;
  3687.   if FInplaceEdit <> nil then FInplaceEdit.FClickTime := GetMessageTime;
  3688. end;
  3689.  
  3690. procedure TIvCustomGrid.WMNCHitTest(var Msg: TWMNCHitTest);
  3691. begin
  3692.   DefaultHandler(Msg);
  3693.   FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos));
  3694. end;
  3695.  
  3696. procedure TIvCustomGrid.WMSetCursor(var Msg: TWMSetCursor);
  3697. var
  3698.   DrawInfo: TIvGridDrawInfo;
  3699.   State: TIvGridState;
  3700.   Index: Longint;
  3701.   Pos, Ofs: Integer;
  3702.   Cur: HCURSOR;
  3703. begin
  3704.   Cur := 0;
  3705.   with Msg do
  3706.   begin
  3707.     if HitTest = HTCLIENT then
  3708.     begin
  3709.       if FGridState = gsNormal then
  3710.       begin
  3711.         CalcDrawInfo(DrawInfo);
  3712.         CalcSizingState(
  3713.           FHitTest.X,
  3714.           FHitTest.Y,
  3715.           State,
  3716.           Index,
  3717.           Pos,
  3718.           Ofs,
  3719.           DrawInfo);
  3720.       end
  3721.       else
  3722.         State := FGridState;
  3723.  
  3724.       if State = gsRowSizing then
  3725.         Cur := Screen.Cursors[crVSplit]
  3726.       else if State = gsColSizing then
  3727.         Cur := Screen.Cursors[crHSplit]
  3728.     end;
  3729.   end;
  3730.  
  3731.   if Cur <> 0 then
  3732.     SetCursor(Cur)
  3733.   else
  3734.     inherited;
  3735. end;
  3736.  
  3737. procedure TIvCustomGrid.WMSetFocus(var Msg: TWMSetFocus);
  3738. begin
  3739.   inherited;
  3740.   if (FInplaceEdit = nil) or (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3741.   begin
  3742.     InvalidateRect(Selection);
  3743.     UpdateEdit;
  3744.   end;
  3745. end;
  3746.  
  3747. procedure TIvCustomGrid.WMSize(var Msg: TWMSize);
  3748. begin
  3749.   inherited;
  3750.   UpdateScrollRange;
  3751. end;
  3752.  
  3753. procedure TIvCustomGrid.WMVScroll(var Msg: TWMVScroll);
  3754. begin
  3755.   ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos);
  3756. end;
  3757.  
  3758. procedure TIvCustomGrid.WMHScroll(var Msg: TWMHScroll);
  3759. begin
  3760.   ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos);
  3761. end;
  3762.  
  3763. procedure TIvCustomGrid.CMCancelMode(var Msg: TMessage);
  3764. begin
  3765.   if Assigned(FInplaceEdit) then FInplaceEdit.WndProc(Msg);
  3766.   inherited;
  3767. end;
  3768.  
  3769. procedure TIvCustomGrid.CMFontChanged(var Message: TMessage);
  3770. begin
  3771.   if FInplaceEdit <> nil then FInplaceEdit.Font := Font;
  3772.   inherited;
  3773. end;
  3774.  
  3775. procedure TIvCustomGrid.CMCtl3DChanged(var Message: TMessage);
  3776. begin
  3777.   inherited;
  3778.   RecreateWnd;
  3779. end;
  3780.  
  3781. procedure TIvCustomGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  3782. begin
  3783.   Msg.Result := Longint(BOOL(Sizing(Msg.Pos.X, Msg.Pos.Y)));
  3784. end;
  3785.  
  3786. procedure TIvCustomGrid.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  3787. begin
  3788.   inherited;
  3789.   if (goEditing in Options) and (Char(Msg.CharCode) = #13) then Msg.Result := 1;
  3790. end;
  3791.  
  3792. procedure TIvCustomGrid.TimedScroll(Direction: TIvGridScrollDirection);
  3793. var
  3794.   MaxAnchor, NewAnchor: TIvGridCoord;
  3795. begin
  3796.   NewAnchor := FAnchor;
  3797.   MaxAnchor.X := ColCount - 1;
  3798.   MaxAnchor.Y := RowCount - 1;
  3799.   if (sdLeft in Direction) and (FAnchor.X > FixedCols) then Dec(NewAnchor.X);
  3800.   if (sdRight in Direction) and (FAnchor.X < MaxAnchor.X) then Inc(NewAnchor.X);
  3801.   if (sdUp in Direction) and (FAnchor.Y > FixedRows) then Dec(NewAnchor.Y);
  3802.   if (sdDown in Direction) and (FAnchor.Y < MaxAnchor.Y) then Inc(NewAnchor.Y);
  3803.   if (FAnchor.X <> NewAnchor.X) or (FAnchor.Y <> NewAnchor.Y) then
  3804.     MoveAnchor(NewAnchor);
  3805. end;
  3806.  
  3807. procedure TIvCustomGrid.WMTimer(var Msg: TWMTimer);
  3808. var
  3809.   Point: TPoint;
  3810.   DrawInfo: TIvGridDrawInfo;
  3811.   ScrollDirection: TIvGridScrollDirection;
  3812.   CellHit: TIvGridCoord;
  3813. begin
  3814.   if not (FGridState in [gsSelecting, gsRowMoving, gsColMoving]) then Exit;
  3815.   GetCursorPos(Point);
  3816.   Point := ScreenToClient(Point);
  3817.   CalcDrawInfo(DrawInfo);
  3818.   ScrollDirection := [];
  3819.   with DrawInfo do
  3820.   begin
  3821.     CellHit := CalcCoordFromPoint(Point.X, Point.Y, DrawInfo);
  3822.     case FGridState of
  3823.       gsColMoving:
  3824.         MoveAndScroll(Point.X, CellHit.X, DrawInfo, Horz, SB_HORZ);
  3825.       gsRowMoving:
  3826.         MoveAndScroll(Point.Y, CellHit.Y, DrawInfo, Vert, SB_VERT);
  3827.       gsSelecting:
  3828.       begin
  3829.         if Point.X < Horz.FixedBoundary then Include(ScrollDirection, sdLeft)
  3830.         else if Point.X > Horz.FullVisBoundary then Include(ScrollDirection, sdRight);
  3831.         if Point.Y < Vert.FixedBoundary then Include(ScrollDirection, sdUp)
  3832.         else if Point.Y > Vert.FullVisBoundary then Include(ScrollDirection, sdDown);
  3833.         if ScrollDirection <> [] then  TimedScroll(ScrollDirection);
  3834.       end;
  3835.     end;
  3836.   end;
  3837. end;
  3838.  
  3839. procedure TIvCustomGrid.ColWidthsChanged;
  3840. begin
  3841.   UpdateScrollRange;
  3842.   UpdateEdit;
  3843. end;
  3844.  
  3845. procedure TIvCustomGrid.RowHeightsChanged;
  3846. begin
  3847.   UpdateScrollRange;
  3848.   UpdateEdit;
  3849. end;
  3850.  
  3851. procedure TIvCustomGrid.DeleteColumn(ACol: Longint);
  3852. begin
  3853.   MoveColumn(ACol, ColCount-1);
  3854.   ColCount := ColCount - 1;
  3855. end;
  3856.  
  3857. procedure TIvCustomGrid.DeleteRow(ARow: Longint);
  3858. begin
  3859.   MoveRow(ARow, RowCount - 1);
  3860.   RowCount := RowCount - 1;
  3861. end;
  3862.  
  3863. procedure TIvCustomGrid.UpdateDesigner;
  3864. {$IFDEF IVWIDE}
  3865. var
  3866.   ParentForm: TCustomForm;
  3867. begin
  3868.   if (csDesigning in ComponentState) and HandleAllocated and
  3869.     not (csUpdating in ComponentState) then
  3870.   begin
  3871.     ParentForm := GetParentForm(Self);
  3872.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  3873.       ParentForm.Designer.Modified;
  3874.   end;
  3875. end;
  3876. {$ELSE}
  3877. var
  3878.   ParentForm: TForm;
  3879. begin
  3880.   if (csDesigning in ComponentState) and HandleAllocated and
  3881.     not (csUpdating in ComponentState) then
  3882.   begin
  3883.     ParentForm := GetParentForm(Self);
  3884.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  3885.       ParentForm.Designer.Modified;
  3886.   end;
  3887. end;
  3888. {$ENDIF}
  3889.  
  3890.  
  3891. { TIvDrawGrid }
  3892.  
  3893. function TIvDrawGrid.CellRect(ACol, ARow: Longint): TRect;
  3894. begin
  3895.   Result := inherited CellRect(ACol, ARow);
  3896. end;
  3897.  
  3898. procedure TIvDrawGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  3899. var
  3900.   Coord: TIvGridCoord;
  3901. begin
  3902.   Coord := MouseCoord(X, Y);
  3903.   ACol := Coord.X;
  3904.   ARow := Coord.Y;
  3905. end;
  3906.  
  3907. procedure TIvDrawGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  3908. begin
  3909.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  3910. end;
  3911.  
  3912. function TIvDrawGrid.GetEditMask(ACol, ARow: Longint): string;
  3913. begin
  3914.   Result := '';
  3915.   if Assigned(FOnGetEditMask) then FOnGetEditMask(Self, ACol, ARow, Result);
  3916. end;
  3917.  
  3918. function TIvDrawGrid.GetEditText(ACol, ARow: Longint): string;
  3919. begin
  3920.   Result := '';
  3921.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  3922. end;
  3923.  
  3924. procedure TIvDrawGrid.RowMoved(FromIndex, ToIndex: Longint);
  3925. begin
  3926.   if Assigned(FOnRowMoved) then FOnRowMoved(Self, FromIndex, ToIndex);
  3927. end;
  3928.  
  3929. function TIvDrawGrid.SelectCell(ACol, ARow: Longint): Boolean;
  3930. begin
  3931.   Result := True;
  3932.   if Assigned(FOnSelectCell) then FOnSelectCell(Self, ACol, ARow, Result);
  3933. end;
  3934.  
  3935. procedure TIvDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  3936. begin
  3937.   if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
  3938. end;
  3939.  
  3940. procedure TIvDrawGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  3941.   AState: TIvGridDrawState);
  3942. begin
  3943.   if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, AState);
  3944. end;
  3945.  
  3946. procedure TIvDrawGrid.TopLeftChanged;
  3947. begin
  3948.   inherited TopLeftChanged;
  3949.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  3950. end;
  3951.  
  3952. { StrItem management for TStringSparseList }
  3953.  
  3954. type
  3955.   PStrItem = ^TStrItem;
  3956.   TStrItem = record
  3957.     FObject: TObject;
  3958.     FString: string;
  3959.   end;
  3960.  
  3961. function NewStrItem(const AString: string; AObject: TObject): PStrItem;
  3962. begin
  3963.   New(Result);
  3964.   Result^.FObject := AObject;
  3965.   Result^.FString := AString;
  3966. end;
  3967.  
  3968. procedure DisposeStrItem(P: PStrItem);
  3969. begin
  3970.   Dispose(P);
  3971. end;
  3972.  
  3973. { Sparse array classes for TStringGrid }
  3974.  
  3975. type
  3976.  
  3977.   PPointer = ^Pointer;
  3978.  
  3979. { Exception classes }
  3980.  
  3981.   EStringSparseListError = class(Exception);
  3982.  
  3983. { TSparsePointerArray class}
  3984.  
  3985. { Used by TSparseList.  Based on Sparse1Array, but has Pointer elements
  3986.   and Integer index, just like TPointerList/TList, and less indirection }
  3987.  
  3988.   { Apply function for the applicator:
  3989.         TheIndex        Index of item in array
  3990.         TheItem         Value of item (i.e pointer element) in section
  3991.         Returns: 0 if success, else error code. }
  3992.   TSPAApply = function(TheIndex: Integer; TheItem: Pointer): Integer;
  3993.  
  3994.   TSecDir = array[0..4095] of Pointer;  { Enough for up to 12 bits of sec }
  3995.   PSecDir = ^TSecDir;
  3996.   TSPAQuantum = (SPASmall, SPALarge);   { Section size }
  3997.  
  3998.   TSparsePointerArray = class(TObject)
  3999.   private
  4000.     secDir: PSecDir;
  4001.     slotsInDir: Word;
  4002.     indexMask, secShift: Word;
  4003.     FHighBound: Integer;
  4004.     FSectionSize: Word;
  4005.     cachedIndex: Integer;
  4006.     cachedPointer: Pointer;
  4007.     { Return item[i], nil if slot outside defined section. }
  4008.     function  GetAt(Index: Integer): Pointer;
  4009.     { Return address of item[i], creating slot if necessary. }
  4010.     function  MakeAt(Index: Integer): PPointer;
  4011.     { Store item at item[i], creating slot if necessary. }
  4012.     procedure PutAt(Index: Integer; Item: Pointer);
  4013.   public
  4014.     constructor Create(Quantum: TSPAQuantum);
  4015.     destructor  Destroy; override;
  4016.  
  4017.     { Traverse SPA, calling apply function for each defined non-nil
  4018.       item.  The traversal terminates if the apply function returns
  4019.       a value other than 0. }
  4020.     { NOTE: must be static method so that we can take its address in
  4021.       TSparseList.ForAll }
  4022.     function  ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  4023.  
  4024.     { Ratchet down HighBound after a deletion }
  4025.     procedure ResetHighBound;
  4026.  
  4027.     property HighBound: Integer read FHighBound;
  4028.     property SectionSize: Word read FSectionSize;
  4029.     property Items[Index: Integer]: Pointer read GetAt write PutAt; default;
  4030.   end;
  4031.  
  4032. { TSparseList class }
  4033.  
  4034.   TSparseList = class(TObject)
  4035.   private
  4036.     FList: TSparsePointerArray;
  4037.     FCount: Integer;    { 1 + HighBound, adjusted for Insert/Delete }
  4038.     FQuantum: TSPAQuantum;
  4039.     procedure NewList(Quantum: TSPAQuantum);
  4040.   protected
  4041.     procedure Error; virtual;
  4042.     function  Get(Index: Integer): Pointer;
  4043.     procedure Put(Index: Integer; Item: Pointer);
  4044.   public
  4045.     constructor Create(Quantum: TSPAQuantum);
  4046.     destructor  Destroy; override;
  4047.     procedure Clear;
  4048.     procedure Delete(Index: Integer);
  4049.     procedure Exchange(Index1, Index2: Integer);
  4050.     function ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  4051.     procedure Insert(Index: Integer; Item: Pointer);
  4052.     procedure Move(CurIndex, NewIndex: Integer);
  4053.     property Count: Integer read FCount;
  4054.     property Items[Index: Integer]: Pointer read Get write Put; default;
  4055.   end;
  4056.   PSparseList = ^TSparseList;
  4057.  
  4058. { TStringSparseList class }
  4059.  
  4060.   TStringSparseList = class(TStrings)
  4061.   private
  4062.     FList: TSparseList;                 { of StrItems }
  4063.     FOnChange: TNotifyEvent;
  4064.   protected
  4065.     function  Get(Index: Integer): String; override;
  4066.     function  GetCount: Integer; override;
  4067.     function  GetObject(Index: Integer): TObject; override;
  4068.     procedure Put(Index: Integer; const S: String); override;
  4069.     procedure PutObject(Index: Integer; AObject: TObject); override;
  4070.     procedure Changed; virtual;
  4071.     procedure Error; virtual;
  4072.   public
  4073.     constructor Create(Quantum: TSPAQuantum);
  4074.     destructor  Destroy; override;
  4075.     procedure ReadData(Reader: TReader);
  4076.     procedure WriteData(Writer: TWriter);
  4077.     procedure DefineProperties(Filer: TFiler); override;
  4078.     procedure Delete(Index: Integer); override;
  4079.     procedure Exchange(Index1, Index2: Integer); override;
  4080.     procedure Insert(Index: Integer; const S: String); override;
  4081.     procedure Clear; override;
  4082.     property List: TSparseList read FList;
  4083.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  4084.   end;
  4085.  
  4086. { TSparsePointerArray }
  4087.  
  4088. const
  4089.   SPAIndexMask: array[TSPAQuantum] of Byte = (15, 255);
  4090.   SPASecShift: array[TSPAQuantum] of Byte = (4, 8);
  4091.  
  4092. { Expand Section Directory to cover at least `newSlots' slots. Returns: Possibly
  4093.   updated pointer to the Section Directory. }
  4094. function  ExpandDir(secDir: PSecDir; var slotsInDir: Word;
  4095.   newSlots: Word): PSecDir;
  4096. begin
  4097.   Result := secDir;
  4098.   ReallocMem(Result, newSlots * SizeOf(Pointer));
  4099.   FillChar(Result^[slotsInDir], (newSlots - slotsInDir) * SizeOf(Pointer), 0);
  4100.   slotsInDir := newSlots;
  4101. end;
  4102.  
  4103. { Allocate a section and set all its items to nil. Returns: Pointer to start of
  4104.   section. }
  4105. function  MakeSec(SecIndex: Integer; SectionSize: Word): Pointer;
  4106. var
  4107.   SecP: Pointer;
  4108.   Size: Word;
  4109. begin
  4110.   Size := SectionSize * SizeOf(Pointer);
  4111.   GetMem(secP, size);
  4112.   FillChar(secP^, size, 0);
  4113.   MakeSec := SecP
  4114. end;
  4115.  
  4116. constructor TSparsePointerArray.Create(Quantum: TSPAQuantum);
  4117. begin
  4118.   SecDir := nil;
  4119.   SlotsInDir := 0;
  4120.   FHighBound := -1;
  4121.   FSectionSize := Word(SPAIndexMask[Quantum]) + 1;
  4122.   IndexMask := Word(SPAIndexMask[Quantum]);
  4123.   SecShift := Word(SPASecShift[Quantum]);
  4124.   CachedIndex := -1
  4125. end;
  4126.  
  4127. destructor TSparsePointerArray.Destroy;
  4128. var
  4129.   i:  Integer;
  4130.   size: Word;
  4131. begin
  4132.   { Scan section directory and free each section that exists. }
  4133.   i := 0;
  4134.   size := FSectionSize * SizeOf(Pointer);
  4135.   while i < slotsInDir do begin
  4136.     if secDir^[i] <> nil then
  4137.       FreeMem(secDir^[i], size);
  4138.     Inc(i)
  4139.   end;
  4140.  
  4141.   { Free section directory. }
  4142.   if secDir <> nil then
  4143.     FreeMem(secDir, slotsInDir * SizeOf(Pointer));
  4144. end;
  4145.  
  4146. function  TSparsePointerArray.GetAt(Index: Integer): Pointer;
  4147. var
  4148.   byteP: PChar;
  4149.   secIndex: Cardinal;
  4150. begin
  4151.   { Index into Section Directory using high order part of
  4152.     index.  Get pointer to Section. If not null, index into
  4153.     Section using low order part of index. }
  4154.   if Index = cachedIndex then
  4155.     Result := cachedPointer
  4156.   else begin
  4157.     secIndex := Index shr secShift;
  4158.     if secIndex >= slotsInDir then
  4159.       byteP := nil
  4160.     else begin
  4161.       byteP := secDir^[secIndex];
  4162.       if byteP <> nil then begin
  4163.         Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  4164.       end
  4165.     end;
  4166.     if byteP = nil then Result := nil else Result := PPointer(byteP)^;
  4167.     cachedIndex := Index;
  4168.     cachedPointer := Result
  4169.   end
  4170. end;
  4171.  
  4172. function  TSparsePointerArray.MakeAt(Index: Integer): PPointer;
  4173. var
  4174.   dirP: PSecDir;
  4175.   p: Pointer;
  4176.   byteP: PChar;
  4177.   secIndex: Word;
  4178. begin
  4179.   { Expand Section Directory if necessary. }
  4180.   secIndex := Index shr secShift;       { Unsigned shift }
  4181.   if secIndex >= slotsInDir then
  4182.     dirP := expandDir(secDir, slotsInDir, secIndex + 1)
  4183.   else
  4184.     dirP := secDir;
  4185.  
  4186.   { Index into Section Directory using high order part of
  4187.     index.  Get pointer to Section. If null, create new
  4188.     Section.  Index into Section using low order part of index. }
  4189.   secDir := dirP;
  4190.   p := dirP^[secIndex];
  4191.   if p = nil then begin
  4192.     p := makeSec(secIndex, FSectionSize);
  4193.     dirP^[secIndex] := p
  4194.   end;
  4195.   byteP := p;
  4196.   Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  4197.   if Index > FHighBound then
  4198.     FHighBound := Index;
  4199.   Result := PPointer(byteP);
  4200.   cachedIndex := -1
  4201. end;
  4202.  
  4203. procedure TSparsePointerArray.PutAt(Index: Integer; Item: Pointer);
  4204. begin
  4205.   if (Item <> nil) or (GetAt(Index) <> nil) then
  4206.   begin
  4207.     MakeAt(Index)^ := Item;
  4208.     if Item = nil then
  4209.       ResetHighBound
  4210.   end
  4211. end;
  4212.  
  4213. function  TSparsePointerArray.ForAll(ApplyFunction: Pointer {TSPAApply}):
  4214.   Integer;
  4215. var
  4216.   itemP: PChar;                         { Pointer to item in section }
  4217.   item: Pointer;
  4218.   i, callerBP: Cardinal;
  4219.   j, index: Integer;
  4220. begin
  4221.   { Scan section directory and scan each section that exists,
  4222.     calling the apply function for each non-nil item.
  4223.     The apply function must be a far local function in the scope of
  4224.     the procedure P calling ForAll.  The trick of setting up the stack
  4225.     frame (taken from TurboVision's TCollection.ForEach) allows the
  4226.     apply function access to P's arguments and local variables and,
  4227.     if P is a method, the instance variables and methods of P's class }
  4228.   Result := 0;
  4229.   i := 0;
  4230.   asm
  4231.     mov   eax,[ebp]                     { Set up stack frame for local }
  4232.     mov   callerBP,eax
  4233.   end;
  4234.   while (i < slotsInDir) and (Result = 0) do begin
  4235.     itemP := secDir^[i];
  4236.     if itemP <> nil then begin
  4237.       j := 0;
  4238.       index := i shl SecShift;
  4239.       while (j < FSectionSize) and (Result = 0) do begin
  4240.         item := PPointer(itemP)^;
  4241.         if item <> nil then
  4242.           { ret := ApplyFunction(index, item.Ptr); }
  4243.           asm
  4244.             mov   eax,index
  4245.             mov   edx,item
  4246.             push  callerBP
  4247.             call  ApplyFunction
  4248.             pop   ecx
  4249.             mov   @Result,eax
  4250.           end;
  4251.         Inc(itemP, SizeOf(Pointer));
  4252.         Inc(j);
  4253.         Inc(index)
  4254.       end
  4255.     end;
  4256.     Inc(i)
  4257.   end;
  4258. end;
  4259.  
  4260. procedure TSparsePointerArray.ResetHighBound;
  4261. var
  4262.   NewHighBound: Integer;
  4263.  
  4264.   function  Detector(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4265.   begin
  4266.     if TheIndex > FHighBound then
  4267.       Result := 1
  4268.     else
  4269.     begin
  4270.       Result := 0;
  4271.       if TheItem <> nil then NewHighBound := TheIndex
  4272.     end
  4273.   end;
  4274.  
  4275. begin
  4276.   NewHighBound := -1;
  4277.   ForAll(@Detector);
  4278.   FHighBound := NewHighBound
  4279. end;
  4280.  
  4281. { TSparseList }
  4282.  
  4283. constructor TSparseList.Create(Quantum: TSPAQuantum);
  4284. begin
  4285.   NewList(Quantum)
  4286. end;
  4287.  
  4288. destructor TSparseList.Destroy;
  4289. begin
  4290.   if FList <> nil then FList.Destroy
  4291. end;
  4292.  
  4293.  
  4294. procedure TSparseList.Clear;
  4295. begin
  4296.   FList.Destroy;
  4297.   NewList(FQuantum);
  4298.   FCount := 0
  4299. end;
  4300.  
  4301. procedure TSparseList.Delete(Index: Integer);
  4302. var
  4303.   I: Integer;
  4304. begin
  4305.   if (Index < 0) or (Index >= FCount) then Exit;
  4306.   for I := Index to FCount - 1 do
  4307.     FList[I] := FList[I + 1];
  4308.   FList[FCount] := nil;
  4309.   Dec(FCount);
  4310. end;
  4311.  
  4312. procedure TSparseList.Error;
  4313. begin
  4314. {$IFDEF IVWIDE}
  4315.   raise EListError.Create(SListIndexError);
  4316. {$ELSE}
  4317.   raise EListError.CreateRes(SListIndexError);
  4318. {$ENDIF}
  4319. end;
  4320.  
  4321. procedure TSparseList.Exchange(Index1, Index2: Integer);
  4322. var
  4323.   temp: Pointer;
  4324. begin
  4325.   temp := Get(Index1);
  4326.   Put(Index1, Get(Index2));
  4327.   Put(Index2, temp);
  4328. end;
  4329.  
  4330. { Jump to TSparsePointerArray.ForAll so that it looks like it was called
  4331.   from our caller, so that the BP trick works. }
  4332.  
  4333. function TSparseList.ForAll(ApplyFunction: Pointer {TSPAApply}): Integer; assembler;
  4334. asm
  4335.         MOV     EAX,[EAX].TSparseList.FList
  4336.         JMP     TSparsePointerArray.ForAll
  4337. end;
  4338.  
  4339. function  TSparseList.Get(Index: Integer): Pointer;
  4340. begin
  4341.   if Index < 0 then Error;
  4342.   Result := FList[Index]
  4343. end;
  4344.  
  4345. procedure TSparseList.Insert(Index: Integer; Item: Pointer);
  4346. var
  4347.   i: Integer;
  4348. begin
  4349.   if Index < 0 then Error;
  4350.   I := FCount;
  4351.   while I > Index do
  4352.   begin
  4353.     FList[i] := FList[i - 1];
  4354.     Dec(i)
  4355.   end;
  4356.   FList[Index] := Item;
  4357.   if Index > FCount then FCount := Index;
  4358.   Inc(FCount)
  4359. end;
  4360.  
  4361. procedure TSparseList.Move(CurIndex, NewIndex: Integer);
  4362. var
  4363.   Item: Pointer;
  4364. begin
  4365.   if CurIndex <> NewIndex then
  4366.   begin
  4367.     Item := Get(CurIndex);
  4368.     Delete(CurIndex);
  4369.     Insert(NewIndex, Item);
  4370.   end;
  4371. end;
  4372.  
  4373. procedure TSparseList.NewList(Quantum: TSPAQuantum);
  4374. begin
  4375.   FQuantum := Quantum;
  4376.   FList := TSparsePointerArray.Create(Quantum)
  4377. end;
  4378.  
  4379. procedure TSparseList.Put(Index: Integer; Item: Pointer);
  4380. begin
  4381.   if Index < 0 then Error;
  4382.   FList[Index] := Item;
  4383.   FCount := FList.HighBound + 1
  4384. end;
  4385.  
  4386. { TStringSparseList }
  4387.  
  4388. constructor TStringSparseList.Create(Quantum: TSPAQuantum);
  4389. begin
  4390.   FList := TSparseList.Create(Quantum)
  4391. end;
  4392.  
  4393. destructor  TStringSparseList.Destroy;
  4394. begin
  4395.   if FList <> nil then begin
  4396.     Clear;
  4397.     FList.Destroy
  4398.   end
  4399. end;
  4400.  
  4401. procedure TStringSparseList.ReadData(Reader: TReader);
  4402. var
  4403.   i: Integer;
  4404. begin
  4405.   with Reader do begin
  4406.     i := Integer(ReadInteger);
  4407.     while i > 0 do begin
  4408.       InsertObject(Integer(ReadInteger), ReadString, nil);
  4409.       Dec(i)
  4410.     end
  4411.   end
  4412. end;
  4413.  
  4414. procedure TStringSparseList.WriteData(Writer: TWriter);
  4415. var
  4416.   itemCount: Integer;
  4417.  
  4418.   function  CountItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4419.   begin
  4420.     Inc(itemCount);
  4421.     Result := 0
  4422.   end;
  4423.  
  4424.   function  StoreItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4425.   begin
  4426.     with Writer do
  4427.     begin
  4428.       WriteInteger(TheIndex);           { Item index }
  4429.       WriteString(PStrItem(TheItem)^.FString);
  4430.     end;
  4431.     Result := 0
  4432.   end;
  4433.  
  4434. begin
  4435.   with Writer do
  4436.   begin
  4437.     itemCount := 0;
  4438.     FList.ForAll(@CountItem);
  4439.     WriteInteger(itemCount);
  4440.     FList.ForAll(@StoreItem);
  4441.   end
  4442. end;
  4443.  
  4444. procedure TStringSparseList.DefineProperties(Filer: TFiler);
  4445. begin
  4446.   Filer.DefineProperty('List', ReadData, WriteData, True);
  4447. end;
  4448.  
  4449. function  TStringSparseList.Get(Index: Integer): String;
  4450. var
  4451.   p: PStrItem;
  4452. begin
  4453.   p := PStrItem(FList[Index]);
  4454.   if p = nil then Result := '' else Result := p^.FString
  4455. end;
  4456.  
  4457. function  TStringSparseList.GetCount: Integer;
  4458. begin
  4459.   Result := FList.Count
  4460. end;
  4461.  
  4462. function  TStringSparseList.GetObject(Index: Integer): TObject;
  4463. var
  4464.   p: PStrItem;
  4465. begin
  4466.   p := PStrItem(FList[Index]);
  4467.   if p = nil then Result := nil else Result := p^.FObject
  4468. end;
  4469.  
  4470. procedure TStringSparseList.Put(Index: Integer; const S: String);
  4471. var
  4472.   p: PStrItem;
  4473.   obj: TObject;
  4474. begin
  4475.   p := PStrItem(FList[Index]);
  4476.   if p = nil then obj := nil else obj := p^.FObject;
  4477.   if (S = '') and (obj = nil) then   { Nothing left to store }
  4478.     FList[Index] := nil
  4479.   else
  4480.     FList[Index] := NewStrItem(S, obj);
  4481.   if p <> nil then DisposeStrItem(p);
  4482.   Changed
  4483. end;
  4484.  
  4485. procedure TStringSparseList.PutObject(Index: Integer; AObject: TObject);
  4486. var
  4487.   p: PStrItem;
  4488. begin
  4489.   p := PStrItem(FList[Index]);
  4490.   if p <> nil then
  4491.     p^.FObject := AObject
  4492.   else if AObject <> nil then
  4493.     FList[Index] := NewStrItem('',AObject);
  4494.   Changed
  4495. end;
  4496.  
  4497. procedure TStringSparseList.Changed;
  4498. begin
  4499.   if Assigned(FOnChange) then FOnChange(Self)
  4500. end;
  4501.  
  4502. procedure TStringSparseList.Error;
  4503. begin
  4504. {$IFDEF IVWIDE}
  4505.   raise EStringSparseListError.Create(SPutObjectError);
  4506. {$ELSE}
  4507.   raise EStringSparseListError.CreateRes(SPutObjectError);
  4508. {$ENDIF}
  4509. end;
  4510.  
  4511. procedure TStringSparseList.Delete(Index: Integer);
  4512. var
  4513.   p: PStrItem;
  4514. begin
  4515.   p := PStrItem(FList[Index]);
  4516.   if p <> nil then DisposeStrItem(p);
  4517.   FList.Delete(Index);
  4518.   Changed
  4519. end;
  4520.  
  4521. procedure TStringSparseList.Exchange(Index1, Index2: Integer);
  4522. begin
  4523.   FList.Exchange(Index1, Index2);
  4524. end;
  4525.  
  4526. procedure TStringSparseList.Insert(Index: Integer; const S: String);
  4527. begin
  4528.   FList.Insert(Index, NewStrItem(S, nil));
  4529.   Changed
  4530. end;
  4531.  
  4532. procedure TStringSparseList.Clear;
  4533.  
  4534.   function  ClearItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4535.   begin
  4536.     DisposeStrItem(PStrItem(TheItem));    { Item guaranteed non-nil }
  4537.     Result := 0
  4538.   end;
  4539.  
  4540. begin
  4541.   FList.ForAll(@ClearItem);
  4542.   FList.Clear;
  4543.   Changed
  4544. end;
  4545.  
  4546. { TIvStringGridStrings }
  4547.  
  4548. constructor TIvStringGridStrings.Create(AGrid: TIvStringGrid; AIndex: Longint);
  4549. begin
  4550.   inherited Create;
  4551.   FGrid := AGrid;
  4552.   FIndex := AIndex;
  4553. end;
  4554.  
  4555. procedure TIvStringGridStrings.Assign(Source: TPersistent);
  4556. var
  4557.   I, Max: Integer;
  4558. begin
  4559.   if Source is TStrings then
  4560.   begin
  4561.     BeginUpdate;
  4562.     Max := TStrings(Source).Count - 1;
  4563.     if Max >= Count then Max := Count - 1;
  4564.     try
  4565.       for I := 0 to Max do
  4566.       begin
  4567.         Put(I, TStrings(Source).Strings[I]);
  4568.         PutObject(I, TStrings(Source).Objects[I]);
  4569.       end;
  4570.     finally
  4571.       EndUpdate;
  4572.     end;
  4573.     Exit;
  4574.   end;
  4575.   inherited Assign(Source);
  4576. end;
  4577.  
  4578. procedure TIvStringGridStrings.CalcXY(Index: Integer; var X, Y: Integer);
  4579. begin
  4580.   if FIndex = 0 then
  4581.   begin
  4582.     X := -1; Y := -1;
  4583.   end else if FIndex > 0 then
  4584.   begin
  4585.     X := Index;
  4586.     Y := FIndex - 1;
  4587.   end else
  4588.   begin
  4589.     X := -FIndex - 1;
  4590.     Y := Index;
  4591.   end;
  4592. end;
  4593.  
  4594. { Changes the meaning of Add to mean copy to the first empty string }
  4595. function TIvStringGridStrings.Add(const S: string): Integer;
  4596. var
  4597.   I: Integer;
  4598. begin
  4599.   for I := 0 to Count - 1 do
  4600.     if Strings[I] = '' then
  4601.     begin
  4602.       Strings[I] := S;
  4603.       Result := I;
  4604.       Exit;
  4605.     end;
  4606.   Result := -1;
  4607. end;
  4608.  
  4609. procedure TIvStringGridStrings.Clear;
  4610. var
  4611.   SSList: TStringSparseList;
  4612.   I: Integer;
  4613.  
  4614.   function BlankStr(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4615.   begin
  4616.     Objects[TheIndex] := nil;
  4617.     Strings[TheIndex] := '';
  4618.     Result := 0;
  4619.   end;
  4620.  
  4621. begin
  4622.   if FIndex > 0 then
  4623.   begin
  4624.     SSList := TStringSparseList(TSparseList(FGrid.FData)[FIndex - 1]);
  4625.     if SSList <> nil then SSList.List.ForAll(@BlankStr);
  4626.   end
  4627.   else if FIndex < 0 then
  4628.     for I := Count - 1 downto 0 do
  4629.     begin
  4630.       Objects[I] := nil;
  4631.       Strings[I] := '';
  4632.     end;
  4633. end;
  4634.  
  4635. {$IFDEF IVWIDE}
  4636. procedure TIvStringGridStrings.Delete(Index: Integer);
  4637. begin
  4638.   InvalidOp(sInvalidStringGridOp);
  4639. end;
  4640.  
  4641. procedure TIvStringGridStrings.Insert(Index: Integer; const S: string);
  4642. begin
  4643.   InvalidOp(sInvalidStringGridOp);
  4644. end;
  4645. {$ENDIF}
  4646.  
  4647. function TIvStringGridStrings.Get(Index: Integer): string;
  4648. var
  4649.   X, Y: Integer;
  4650. begin
  4651.   CalcXY(Index, X, Y);
  4652.   if X < 0 then Result := '' else Result := FGrid.Cells[X, Y];
  4653. end;
  4654.  
  4655. function TIvStringGridStrings.GetCount: Integer;
  4656. begin
  4657.   { Count of a row is the column count, and vice versa }
  4658.   if FIndex = 0 then Result := 0
  4659.   else if FIndex > 0 then Result := Integer(FGrid.ColCount)
  4660.   else Result := Integer(FGrid.RowCount);
  4661. end;
  4662.  
  4663. function TIvStringGridStrings.GetObject(Index: Integer): TObject;
  4664. var
  4665.   X, Y: Integer;
  4666. begin
  4667.   CalcXY(Index, X, Y);
  4668.   if X < 0 then Result := nil else Result := FGrid.Objects[X, Y];
  4669. end;
  4670.  
  4671. procedure TIvStringGridStrings.Put(Index: Integer; const S: string);
  4672. var
  4673.   X, Y: Integer;
  4674. begin
  4675.   CalcXY(Index, X, Y);
  4676.   FGrid.Cells[X, Y] := S;
  4677. end;
  4678.  
  4679. procedure TIvStringGridStrings.PutObject(Index: Integer; AObject: TObject);
  4680. var
  4681.   X, Y: Integer;
  4682. begin
  4683.   CalcXY(Index, X, Y);
  4684.   FGrid.Objects[X, Y] := AObject;
  4685. end;
  4686.  
  4687. procedure TIvStringGridStrings.SetUpdateState(Updating: Boolean);
  4688. begin
  4689.   FGrid.SetUpdateState(Updating);
  4690. end;
  4691.  
  4692. { TIvStringGrid }
  4693.  
  4694. constructor TIvStringGrid.Create(AOwner: TComponent);
  4695. begin
  4696.   inherited Create(AOwner);
  4697.   Initialize;
  4698. end;
  4699.  
  4700. destructor TIvStringGrid.Destroy;
  4701.  
  4702.   function FreeItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4703.   begin
  4704.     TObject(TheItem).Free;
  4705.     Result := 0;
  4706.   end;
  4707.  
  4708. begin
  4709.   if FRows <> nil then
  4710.   begin
  4711.     TSparseList(FRows).ForAll(@FreeItem);
  4712.     TSparseList(FRows).Free;
  4713.   end;
  4714.  
  4715.   if FCols <> nil then
  4716.   begin
  4717.     TSparseList(FCols).ForAll(@FreeItem);
  4718.     TSparseList(FCols).Free;
  4719.   end;
  4720.  
  4721.   if FData <> nil then
  4722.   begin
  4723.     TSparseList(FData).ForAll(@FreeItem);
  4724.     TSparseList(FData).Free;
  4725.   end;
  4726.  
  4727.   inherited Destroy;
  4728. end;
  4729.  
  4730. procedure TIvStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  4731.  
  4732.   function MoveColData(Index: Integer; ARow: TStringSparseList): Integer; far;
  4733.   begin
  4734.     ARow.Move(FromIndex, ToIndex);
  4735.     Result := 0;
  4736.   end;
  4737.  
  4738. begin
  4739.   TSparseList(FData).ForAll(@MoveColData);
  4740.   Invalidate;
  4741.   inherited ColumnMoved(FromIndex, ToIndex);
  4742. end;
  4743.  
  4744. procedure TIvStringGrid.RowMoved(FromIndex, ToIndex: Longint);
  4745. begin
  4746.   TSparseList(FData).Move(FromIndex, ToIndex);
  4747.   Invalidate;
  4748.   inherited RowMoved(FromIndex, ToIndex);
  4749. end;
  4750.  
  4751. function TIvStringGrid.GetEditText(ACol, ARow: Longint): string;
  4752. begin
  4753.   Result := Cells[ACol, ARow];
  4754.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  4755. end;
  4756.  
  4757. procedure TIvStringGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  4758. begin
  4759.   DisableEditUpdate;
  4760.   try
  4761.     if Value <> Cells[ACol, ARow] then Cells[ACol, ARow] := Value;
  4762.   finally
  4763.     EnableEditUpdate;
  4764.   end;
  4765.   inherited SetEditText(ACol, ARow, Value);
  4766. end;
  4767.  
  4768. procedure TIvStringGrid.DrawCell(
  4769.   ACol, ARow: Longint;
  4770.   ARect: TRect;
  4771.   AState: TIvGridDrawState);
  4772. var
  4773.   str: String;
  4774.   flags: Integer;
  4775. begin
  4776.   if DefaultDrawing then
  4777.   begin
  4778.     str := Cells[ACol, ARow];
  4779.     begin
  4780.       InflateRect(ARect, -2, -2);
  4781.       flags := DT_LEFT;
  4782.     end;
  4783.     DrawTextEx(
  4784.       Canvas.Handle,
  4785.       PChar(str),
  4786.       Length(str),
  4787.       ARect,
  4788.       flags,
  4789.       nil);
  4790.   end;
  4791.   inherited DrawCell(ACol, ARow, ARect, AState);
  4792. end;
  4793.  
  4794. procedure TIvStringGrid.DisableEditUpdate;
  4795. begin
  4796.   Inc(FEditUpdate);
  4797. end;
  4798.  
  4799. procedure TIvStringGrid.EnableEditUpdate;
  4800. begin
  4801.   Dec(FEditUpdate);
  4802. end;
  4803.  
  4804. procedure TIvStringGrid.Initialize;
  4805. var
  4806.   quantum: TSPAQuantum;
  4807. begin
  4808.   if FCols = nil then
  4809.   begin
  4810.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4811.     FCols := TSparseList.Create(quantum);
  4812.   end;
  4813.   if RowCount > 256 then quantum := SPALarge else quantum := SPASmall;
  4814.   if FRows = nil then FRows := TSparseList.Create(quantum);
  4815.   if FData = nil then FData := TSparseList.Create(quantum);
  4816. end;
  4817.  
  4818. procedure TIvStringGrid.SetUpdateState(Updating: Boolean);
  4819. begin
  4820.   FUpdating := Updating;
  4821.   if not Updating and FNeedsUpdating then
  4822.   begin
  4823.     InvalidateGrid;
  4824.     FNeedsUpdating := False;
  4825.   end;
  4826. end;
  4827.  
  4828. procedure TIvStringGrid.UpdateCell(ACol, ARow: Integer);
  4829. begin
  4830.   if not FUpdating then InvalidateCell(ACol, ARow)
  4831.   else FNeedsUpdating := True;
  4832.   if (ACol = Col) and (ARow = Row) and (FEditUpdate = 0) then InvalidateEditor;
  4833. end;
  4834.  
  4835. function  TIvStringGrid.EnsureColRow(Index: Integer; IsCol: Boolean):
  4836.   TIvStringGridStrings;
  4837. var
  4838.   RCIndex: Integer;
  4839.   PList: PSparseList;
  4840. begin
  4841.   if IsCol then
  4842.     PList := PSparseList(@FCols)
  4843.   else
  4844.     PList := PSparseList(@FRows);
  4845.   Result := TIvStringGridStrings(PList^[Index]);
  4846.   if Result = nil then
  4847.   begin
  4848.     if IsCol then RCIndex := -Index - 1 else RCIndex := Index + 1;
  4849.     Result := TIvStringGridStrings.Create(Self, RCIndex);
  4850.     PList^[Index] := Result;
  4851.   end;
  4852. end;
  4853.  
  4854. function  TIvStringGrid.EnsureDataRow(ARow: Integer): Pointer;
  4855. var
  4856.   quantum: TSPAQuantum;
  4857. begin
  4858.   Result := TStringSparseList(TSparseList(FData)[ARow]);
  4859.   if Result = nil then
  4860.   begin
  4861.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4862.     Result := TStringSparseList.Create(quantum);
  4863.     TSparseList(FData)[ARow] := Result;
  4864.   end;
  4865. end;
  4866.  
  4867. function TIvStringGrid.GetCells(ACol, ARow: Integer): string;
  4868. var
  4869.   ssl: TStringSparseList;
  4870. begin
  4871.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4872.   if ssl = nil then Result := '' else Result := ssl[ACol];
  4873. end;
  4874.  
  4875. function TIvStringGrid.GetCols(Index: Integer): TStrings;
  4876. begin
  4877.   Result := EnsureColRow(Index, True);
  4878. end;
  4879.  
  4880. function TIvStringGrid.GetObjects(ACol, ARow: Integer): TObject;
  4881. var
  4882.   ssl: TStringSparseList;
  4883. begin
  4884.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4885.   if ssl = nil then Result := nil else Result := ssl.Objects[ACol];
  4886. end;
  4887.  
  4888. function TIvStringGrid.GetRows(Index: Integer): TStrings;
  4889. begin
  4890.   Result := EnsureColRow(Index, False);
  4891. end;
  4892.  
  4893. procedure TIvStringGrid.SetCells(ACol, ARow: Integer; const Value: string);
  4894. begin
  4895.   TIvStringGridStrings(EnsureDataRow(ARow))[ACol] := Value;
  4896.   EnsureColRow(ACol, True);
  4897.   EnsureColRow(ARow, False);
  4898.   UpdateCell(ACol, ARow);
  4899. end;
  4900.  
  4901. procedure TIvStringGrid.SetCols(Index: Integer; Value: TStrings);
  4902. begin
  4903.   EnsureColRow(Index, True).Assign(Value);
  4904. end;
  4905.  
  4906. procedure TIvStringGrid.SetObjects(ACol, ARow: Integer; Value: TObject);
  4907. begin
  4908.   TIvStringGridStrings(EnsureDataRow(ARow)).Objects[ACol] := Value;
  4909.   EnsureColRow(ACol, True);
  4910.   EnsureColRow(ARow, False);
  4911.   UpdateCell(ACol, ARow);
  4912. end;
  4913.  
  4914. procedure TIvStringGrid.SetRows(Index: Integer; Value: TStrings);
  4915. begin
  4916.   EnsureColRow(Index, False).Assign(Value);
  4917. end;
  4918. {$ENDIF}
  4919.  
  4920. end.
  4921.  
  4922.  
  4923.